diff --git a/.depend b/.depend index 393ea3d3f..aa146aa71 100644 --- a/.depend +++ b/.depend @@ -2877,6 +2877,7 @@ asmcomp/spacetime_profiling.cmo : \ lambda/lambda.cmi \ lambda/debuginfo.cmi \ utils/config.cmi \ + asmcomp/cmm_helpers.cmi \ asmcomp/cmm.cmi \ middle_end/backend_var.cmi \ parsing/asttypes.cmi \ @@ -2890,6 +2891,7 @@ asmcomp/spacetime_profiling.cmx : \ lambda/lambda.cmx \ lambda/debuginfo.cmx \ utils/config.cmx \ + asmcomp/cmm_helpers.cmx \ asmcomp/cmm.cmx \ middle_end/backend_var.cmx \ parsing/asttypes.cmi \ diff --git a/.gitattributes b/.gitattributes index 4e4be5874..eebcdcffb 100644 --- a/.gitattributes +++ b/.gitattributes @@ -29,9 +29,9 @@ /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 +# configure is a shell-script; the linguist-generated attribute suppresses +# changes being displayed by default in pull requests. +/configure text eol=lf -diff linguist-generated # 'union' merge driver just unions textual content in case of conflict # http://krlmlr.github.io/using-gitattributes-to-avoid-merge-conflicts/ @@ -119,6 +119,10 @@ testsuite/tests/**/*.reference typo.prune # Expect tests with overly long lines of expected output testsuite/tests/parsing/docstrings.ml typo.very-long-line +# The normalisation tests have very specific line endings which mustn't be +# corrupted by git. +testsuite/tests/tool-ocamltest/norm*.reference binary + tools/magic typo.missing-header tools/eventlog_metadata.in typo.missing-header diff --git a/.gitignore b/.gitignore index afac70dab..466edf57b 100644 --- a/.gitignore +++ b/.gitignore @@ -118,6 +118,7 @@ _build /ocamltest/ocamltest /ocamltest/ocamltest.opt /ocamltest/ocamltest_config.ml +/ocamltest/ocamltest_unix.ml /ocamltest/tsl_lexer.ml /ocamltest/tsl_parser.ml /ocamltest/tsl_parser.mli @@ -163,6 +164,7 @@ _build /otherlibs/win32unix/time.c /otherlibs/win32unix/unlink.c /otherlibs/win32unix/fsync.c +/otherlibs/win32unix/mkdir.c /parsing/parser.ml /parsing/parser.mli diff --git a/Changes b/Changes index 5c0182b97..f0e35acbf 100644 --- a/Changes +++ b/Changes @@ -16,6 +16,12 @@ Working version type !'a t = 'a list (Jacques Garrigue, review by Jeremy Yallop and Leo White) +### Supported platforms: + +- #9699: add support for iOS and macOS on ARM 64 bits + (GitHub user @EduardoRFS, review by Xavier Leroy, Nicolás Ojeda Bär + and Anil Madhavapeddy, additional testing by Michael Schmidt) + ### Runtime system: - #1795, #9543: modernize signal handling on Linux i386, PowerPC, and s390x, @@ -48,6 +54,9 @@ Working version (Nicolás Ojeda Bär, review by Stephen Dolan, Gabriel Scherer, Mark Shinwell, and Xavier Leroy) +- #8807, #9503: Use different symbols for do_local_roots on bytecode and native + (Stephen Dolan, review by David Allsopp and Xavier Leroy) + - #9619: Change representation of function closures so that code pointers can be easily distinguished from environment variables (Xavier Leroy, review by Mark Shinwell and Damien Doligez) @@ -90,6 +99,25 @@ Working version compaction algorithm and remove its dependence on the page table (Damien Doligez, review by Jacques-Henri Jourdan and Xavier Leroy) +- #9742: Ephemerons are now compatible with infix pointers occurring + when using mutually recursive functions. + (Jacques-Henri Jourdan, review François Bobot) + +* #1128, #7503, #9036, #9722: EINTR-based signal handling. + When a signal arrives, avoid running its OCaml handler in the middle + of a blocking section. Instead, allow control to return quickly to + a polling point where the signal handler can safely run, ensuring that + I/O locks are not held while it runs. A polling point was removed from + caml_leave_blocking_section, and one added to caml_raise. + (Stephen Dolan, review by Goswin von Brederlow, Xavier Leroy, Damien + Doligez, Anil Madhavapeddy, Guillaume Munch-Maccagnoni and Jacques- + Henri Jourdan) + +- #9888, #9890: Fixes a bug in the `riscv` backend where register t0 was not + saved/restored when performing a GC. This could potentially lead to a + segfault. + (Nicolás Ojeda Bär, report by Xavier Leroy, review by Xavier Leroy) + ### Code generation and optimizations: - #9551: ocamlc no longer loads DLLs at link time to check that @@ -108,11 +136,19 @@ Working version so that the ARM64 iOS/macOS calling conventions can be honored. (Xavier Leroy, review by Mark Shinwell and Github user @EduardoRFS) +- #9838: Ensure that Cmm immediates are generated as Cconst_int where + possible, improving instruction selection. + (Stephen Dolan, review by Leo White and Xavier Leroy) + ### Standard library: - #9781: add injectivity annotations to parameterized abstract types (Jeremy Yallop, review by Nicolás Ojeda Bär) +* #9765: add init functions to Bigarray. + (Jeremy Yallop, review by Gabriel Scherer, Nicolás Ojeda Bär, and + Xavier Leroy) + * #9554: add primitive __FUNCTION__ that returns the name of the current method or function, including any enclosing module or class. (Nicolás Ojeda Bär, Stephen Dolan, review by Stephen Dolan) @@ -131,6 +167,14 @@ Working version - #9571: Make at_exit and Printexc.register_printer thread-safe. (Guillaume Munch-Maccagnoni, review by Gabriel Scherer and Xavier Leroy) +- #9066: a new Either module with + type 'a Either.t = Left of 'a | Right of 'b + (Gabriel Scherer, review by Daniel Bünzli, Thomas Refis, Jeremy Yallop) + +- #9066: List.partition_map : + ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list + (Gabriel Scherer, review by Jeremy Yallop) + - #9587: Arg: new Rest_all spec to get all rest arguments in a list (this is similar to Rest, but makes it possible to detect when there are no arguments (an empty list) after the rest marker) @@ -148,12 +192,21 @@ Working version - #9663: Extend Printexc API for raw backtrace entries. (Stephen Dolan, review by Nicolás Ojeda Bär and Gabriel Scherer) +* #9668: List.equal, List.compare + (This could break code using "open List" by shadowing + Stdlib.{equal,compare}.) + (Gabriel Scherer, review by Nicolás Ojeda Bär, Daniel Bünzli and Alain Frisch) + - #9763: Add function Hashtbl.rebuild to convert from old hash table formats (that may have been saved to persistent storage) to the current hash table format. Remove leftover support for the hash table format and generic hash function that were in use before OCaml 4.00. (Xavier Leroy, review by Nicolás Ojeda Bär) +- #9797: Add Sys.mkdir and Sys.rmdir. + (David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and + Xavier Leroy) + ### Other libraries: * #9206, #9419: update documentation of the threads library; @@ -177,6 +230,16 @@ Working version error handling when Unix.symlink is unavailable) (David Allsopp, review by Xavier Leroy) +- #9338, #9790: Dynlink: make sure *_units () functions report accurate + information before the first load. + (Daniel Bünzli, review by Xavier Leroy and Nicolás Ojeda Bär) + +- #9802: Ensure signals are handled before Unix.kill returns + (Stephen Dolan, review by Jacques-Henri Jourdan) + +- #9869: Add Unix.SO_REUSEPORT + (Yishuai Li, review by Xavier Leroy) + ### Tools: - #9551: ocamlobjinfo is now able to display information on .cmxs shared @@ -189,6 +252,10 @@ Working version (Xavier Leroy, report by Jacques Garrigue and Virgile Prevosto, review by David Allsopp and Jacques-Henri Jourdan) +* #9299, #9795: ocamldep: do not process files during cli parsing. Fixes + various broken cli behaviours. + (Daniel Bünzli, review by Nicolás Ojeda Bär) + ### Manual and documentation: - #9468: HACKING.adoc: using dune to get merlin's support @@ -235,12 +302,19 @@ Working version (Nicolás Ojeda Bär, review by Gabriel Scherer, Florian Angeletti and Leo White) +- #9751: Add warning 68. Pattern-matching depending on mutable state + prevents the remaining arguments from being uncurried. + (Hugo Heuzard, review by Leo White) + ### Internal/compiler-libs changes: - #9216: add Lambda.duplicate which refreshes bound identifiers (Gabriel Scherer, review by Pierre Chambart and Vincent Laviron) -- #9493, #9520, #9563, #9599, #9608, #9647: refactor +- #9376: Remove spurious Ptop_defs from #use + (Leo White, review by Damien Doligez) + +- #9464, #9493, #9520, #9563, #9599, #9608, #9647: refactor the pattern-matching compiler (Thomas Refis and Gabriel Scherer, review by Florian Angeletti) @@ -276,6 +350,25 @@ Working version attributes are present. (Matthew Ryan, review by Nicolás Ojeda Bär) +- #9797, #9849: Eliminate the routine use of external commands in ocamltest. + ocamltest no longer calls the mkdir, rm and ln external commands (at present, + the only external command ocamltest uses is diff). + (David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and + Xavier Leroy) + +- #9801: Don't ignore EOL-at-EOF differences in ocamltest. + (David Allsopp, review by Damien Doligez, much input and thought from + Daniel Bünzli, Damien Doligez, Sébastien Hinderer, and Xavier Leroy) + +- #9889: more caching when printing types with -short-path. + (Florian Angeletti, review by Gabriel Scherer) + +- #9591: fix pprint of polyvariants that start with a core_type, closed, + not low (Chet Murthy, review by Florian Angeletti) + +- #9590: fix pprint of extension constructors (and exceptions) that rebind + (Chet Murthy, review by octachron@) + ### Build system: - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For @@ -292,6 +385,12 @@ Working version to avoid C dependency recomputation. (Gabriel Scherer, review by David Allsopp) +- #9804: Build C stubs of libraries in otherlibs/ with debug info. + (Stephen Dolan, review by Sébastien Hinderer and David Allsopp) + +- #9824, #9837: Honour the CFLAGS and CPPFLAGS variables. + (Sébastien Hinderer, review by David Allsopp) + ### Bug fixes: - #7902, #9556: Type-checker infers recursive type, even though -rectypes is @@ -301,6 +400,13 @@ Working version - #8747, #9709: incorrect principality warning on functional updates of records (Jacques Garrigue, report and review by Thomas Refis) +- #9421, #9427: fix printing of (::) in ocamldoc + (Florian Angeletti, report by Yawar Amin, review by Damien Doligez) + +- #9440: for a type extension constructor with parameterised arguments, + REPL displayed for each as opposed to the concrete values used. + (Christian Quinn, review by Gabriel Scherer) + - #9469: Better backtraces for lazy values (Leo White, review by Nicolás Ojeda Bär) @@ -322,51 +428,72 @@ Working version (Xavier Leroy, Sadiq Jaffer, Gabriel Scherer, review by Xavier Leroy and Jacques-Henri Jourdan) -- #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) +- #9759, #9767: Spurious GADT ambiguity without -principal + (Jacques Garrigue, report by Thomas Refis, + review by Thomas Refis and Gabriel Scherer) -OCaml 4.11 ----------- +- #9825, #9830: the C global variable caml_fl_merge and the C function + caml_spacetime_my_profinfo (bytecode version) were declared and + defined with different types. This is undefined behavior and + cancause link-time errors with link-time optimization (LTO). + (Xavier Leroy, report by Richard Jones, review by Nicolás Ojeda Bär) + +- #9753: fix build for Android + (Github user @EduardoRFS, review by Xavier Leroy) + +- #9848, #9855: Fix double free of bytecode in toplevel + (Stephen Dolan, report by Sampsa Kiiskinen, review by Gabriel Scherer) + +- #9860: wrong range constraint for subtract immediate on zSystems / s390x + (Xavier Leroy, review by Stephen Dolan) + +- #9868, #9872, #9892: bugs in {in,out}_channel_length and seek_in + for files opened in text mode under Windows + (Xavier Leroy, report by Alain Frisch, review by Nicolás Ojeda Bär + and Alain Frisch) + + +OCaml 4.11.1 +------------ + +### 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 "*") -### 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) - -- #6673, #1132, #9617: Relax the handling of explicit polymorphic types - (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) - -- #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) - ### 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) -- #9119: Make [caml_stat_resize_noexc] compatible with the [realloc] - API when the old block is NULL. - (Jacques-Henri Jourdan, review by Xavier Leroy) +- #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 @@ -376,12 +503,20 @@ OCaml 4.11 (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) -- #9230, #9362: Memprof support for native allocations. - (Jacques-Henri Jourdan and Stephen Dolan, review by Gabriel Scherer) - - #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) @@ -398,11 +533,6 @@ OCaml 4.11 - #9280: Micro-optimise allocations on amd64 to save a register. (Stephen Dolan, review by Xavier Leroy) -- #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) - - #9426: build the Mingw ports with higher levels of GCC optimization (Xavier Leroy, review by Sébastien Hinderer) @@ -410,12 +540,6 @@ OCaml 4.11 The only release with the inclusion of stdio.h has been 4.10.0 (Christopher Zimmermann, review by Xavier Leroy and David Allsopp) -- #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) - - #9282: Make Cconst_symbol have typ_int to fix no-naked-pointers mode. (Stephen Dolan, review by Mark Shinwell, Xavier Leroy and Vincent Laviron) @@ -428,40 +552,66 @@ OCaml 4.11 avoiding overflow. (Jeremy Yallop, Stephen Dolan, review by Xavier Leroy) -- #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. - (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) - ### 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) -- #9441: Add RISC-V RV64G native-code backend. - (Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer) +- #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) -- #9248: Add Printexc.default_uncaught_exception_handler - (Raphael Sousa Santos, review by Daniel Bünzli) - - #9235: Add Array.exists2 and Array.for_all2 (Bernhard Schommer, review by Armaël Guéneau) @@ -469,11 +619,6 @@ OCaml 4.11 (Jeremy Yallop, review by Hezekiah M. Carty, Gabriel Scherer and Gabriel Radanne) -- #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) - - #9059: Added List.filteri function, same as List.filter but with the index of the element. (Léo Andrès, review by Alain Frisch) @@ -481,6 +626,18 @@ OCaml 4.11 - #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) @@ -488,23 +645,12 @@ OCaml 4.11 - #7110: Added Printf.ikbprintf and Printf.ibprintf (Muskan Garg, review by Gabriel Scherer and Florian Angeletti) -- #9365: Set.filter_map and Map.filter_map - (Gabriel Scherer, review by Stephen Dolan and Nicolás Ojeda Bär) - - #9266: Install pretty-printer for the exception Fun.Finally_raised. (Guillaume Munch-Maccagnoni, review by Daniel Bünzli, Gabriel Radanne, and Gabriel Scherer) -- #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) - ### Other libraries: -- #9338: Dynlink: make sure *_units () functions report accurate information - before the first load. - (Daniel Bünzli, review by Xavier Leroy and Nicolás Ojeda Bär) - - #9106: Register printer for Unix_error in win32unix, as in unix. (Christopher Zimmermann, review by David Allsopp) @@ -524,9 +670,10 @@ OCaml 4.11 ### Tools: -* #9299: ocamldep: do not process files during cli parsing. Fixes - various broken cli behaviours. - (Daniel Bünzli, review by Nicolás Ojeda Bär) +- #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) @@ -547,10 +694,6 @@ OCaml 4.11 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 @@ -568,29 +711,12 @@ OCaml 4.11 points to the grammar. (Andreas Abel, review by Xavier Leroy) -- #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) - -- #9402: Remove `sudo:false` from .travis.yml - (Hikaru Yoshimura) - -- #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) - - #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: -- #8644: fix formatting comment about @raise in stdlib's mli files - (Élie Brami, review by David Allsopp) - - #9141: beginning of the ocamltest reference manual (Sébastien Hinderer, review by Gabriel Scherer and Thomas Refis) @@ -605,12 +731,8 @@ OCaml 4.11 - #9325: documented base case for `List.for_all` and `List.exists` (Glenn Slotte, review by Florian Angeletti) -- #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) +- #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. @@ -626,12 +748,41 @@ OCaml 4.11 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: -- GPR#1664: make -output-complete-obj link the runtime native c libraries when +- #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). @@ -658,25 +809,21 @@ OCaml 4.11 - #9393: Improve recursive module usage warnings (Leo White, review by Thomas Refis) -- #2141: generate .annot files from cmt data; deprecate -annot. - (Nicolás Ojeda Bär, review by Alain Frisch, Gabriel Scherer and Damien - Doligez) - - #9486: Fix configuration for the Haiku operating system (Sylvain Kerjean, review by David Allsopp and Sébastien Hinderer) -- #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) - ### Internal/compiler-libs changes: - - #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) +- #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 @@ -695,9 +842,6 @@ OCaml 4.11 - #9060: ensure that Misc.protect_refs preserves backtraces (Gabriel Scherer, review by Guillaume Munch-Maccagnoni and David Allsopp) -- #9021: expose compiler Longident.t parsers - (Florian Angeletti, review by Gabriel Scherer) - - #9078: make all compilerlibs/ available to ocamltest. (Gabriel Scherer, review by Sébastien Hinderer) @@ -713,7 +857,7 @@ OCaml 4.11 (Gabriel Scherer, Thomas Refis, Florian Angeletti and Jacques Garrigue, reviewing each other without self-loops) -- #9321, #9322, #9359, #9361, #9417, #9447, #9464: refactor the +- #9321, #9322, #9359, #9361, #9417, #9447: refactor the pattern-matching compiler (Thomas Refis and Gabriel Scherer, review by Florian Angeletti) @@ -721,6 +865,9 @@ OCaml 4.11 compilerlibs, dynlink, ocamltest. (Gabriel Scherer, review by Vincent Laviron and David Allsopp) +- #9275: Short circuit simple inclusion checks + (Leo White, review by Thomas Refis) + - #9305: Avoid polymorphic compare in Ident (Leo White, review by Xavier Leroy and Gabriel Scherer) @@ -734,11 +881,16 @@ OCaml 4.11 - #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) -- #9452: Add locations to docstring attributes - (Leo White, review by Gabriel Scherer) +- #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: @@ -839,6 +991,9 @@ OCaml 4.11 * #9388: Prohibit signature local types with constraints (Leo White, review by Jacques Garrigue) +- #7141, #9389: returns exit_code for better user response on linking_error + (Anukriti Kumar, review by Gabriel Scherer and Valentin Gatien-Baron) + - #9406, #9409: fix an error with packed module types from missing cmis. (Florian Angeletti, report by Thomas Leonard, review by Gabriel Radanne @@ -864,6 +1019,10 @@ OCaml 4.11 - #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 ----------------------------- @@ -893,9 +1052,18 @@ OCaml 4.10 maintenance branch 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++ in MSVC. + Fixes a bug with MSVC C++ 2015 onwards. + (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 by Leo White, review by ???) + (Damien Doligez, report and review by Leo White) + +### Tools: + +- #9552: restore ocamloptp build and installation + (Florian Angeletti, review by David Allsopp and Xavier Leroy) OCaml 4.10.0 (21 February 2020) ------------------------------- @@ -1205,6 +1373,10 @@ OCaml 4.10.0 (21 February 2020) - #9127, #9130: ocamldoc: fix the formatting of closing brace in record types. (David Allsopp, report by San Vu Ngoc) +- #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) + ### Build system: - #8840: use ocaml{c,opt}.opt when available to build internal tools @@ -1405,9 +1577,6 @@ OCaml 4.10.0 (21 February 2020) - #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 ----------------------------- @@ -1438,15 +1607,15 @@ OCaml 4.09.1 (16 Mars 2020) - #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) +- #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) + - #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 @@ -1594,9 +1763,6 @@ OCaml 4.09.0 (19 September 2019) - #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 @@ -1668,9 +1834,6 @@ OCaml 4.09.0 (19 September 2019) (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 @@ -2193,9 +2356,6 @@ OCaml 4.08.0 (13 June 2019) - #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. @@ -2922,9 +3082,6 @@ OCaml 4.07.0 (10 July 2018) 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 diff --git a/HACKING.adoc b/HACKING.adoc index 9843fac80..606695605 100644 --- a/HACKING.adoc +++ b/HACKING.adoc @@ -330,16 +330,16 @@ file. Merlin will be looking at the artefacts generated by dune (in `_build`), rather than trying to open the incompatible artefacts produced by a Makefile build. In -particular, you need to repeat the dune build everytime you change the interface +particular, you need to repeat the dune build every time you change the interface of some compilation unit, so that merlin is aware of the new interface. You only need to run `configure` once, but you will need to run `make clean` -everytime you want to run `dune` after you built something with `make`; +every time you want to run `dune` after you built something with `make`; otherwise dune will complain that build artefacts are present among the sources. Finally, there will be times where the compiler simply cannot be built with an older version of itself. One example of this is when a new primitive is added to -the runtime, and then used in the standard library straightaway, since the rest +the runtime, and then used in the standard library straight away, since the rest of the compiler requires the `stdlib` library to build, nothing can be build. In such situations, you will have to either live without merlin, or develop on an older branch of the compiler, for example the maintenance branch of the last diff --git a/Makefile b/Makefile index 54d8e9df6..57e213a57 100644 --- a/Makefile +++ b/Makefile @@ -53,7 +53,6 @@ else OCAML_NATDYNLINKOPTS = -ccopt "$(NATDYNLINKOPTS)" endif -YACCFLAGS=-v --strict CAMLLEX=$(CAMLRUN) boot/ocamllex CAMLDEP=$(CAMLRUN) boot/ocamlc -depend DEPFLAGS=-slash @@ -78,10 +77,10 @@ COMPLIBDIR=$(LIBDIR)/compiler-libs TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES))) RUNTOP=./runtime/ocamlrun$(EXE) ./ocaml$(EXE) \ - -nostdlib -I stdlib \ + -nostdlib -I stdlib -I toplevel \ -noinit $(TOPFLAGS) $(TOPINCLUDES) NATRUNTOP=./ocamlnat$(EXE) \ - -nostdlib -I stdlib \ + -nostdlib -I stdlib -I toplevel \ -noinit $(TOPFLAGS) $(TOPINCLUDES) ifeq "$(UNIX_OR_WIN32)" "unix" EXTRAPATH= @@ -868,7 +867,7 @@ ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex $(MAKE) -C ocamldoc opt.opt # OCamltest -ocamltest: ocamlc ocamlyacc ocamllex +ocamltest: ocamlc ocamlyacc ocamllex otherlibraries $(MAKE) -C ocamltest all ocamltest.opt: ocamlc.opt ocamlyacc ocamllex @@ -928,13 +927,16 @@ 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) +checkstack := tools/checkstack +checkstack: $(checkstack)$(EXE) + $< + +.INTERMEDIATE: $(checkstack)$(EXE) $(checkstack).$(O) +$(checkstack)$(EXE): $(checkstack).$(O) + $(MKEXE) $(OUTPUTEXE)$@ $< else +checkstack: @ endif diff --git a/Makefile.common b/Makefile.common index 02dd5fbfd..ae3a1aad9 100644 --- a/Makefile.common +++ b/Makefile.common @@ -109,7 +109,8 @@ REQUIRED_HEADERS := $(RUNTIME_HEADERS) $(wildcard *.h) endif %.$(O): %.c $(REQUIRED_HEADERS) - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $< + $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \ + $(OUTPUTOBJ)$@ $< $(DEPDIR): $(MKDIR) $@ diff --git a/Makefile.config.in b/Makefile.config.in index 35fd7aedd..26741a5b2 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -129,7 +129,7 @@ ARCH=@arch@ # Whether the architecture has 64 bits ARCH64=@arch64@ -# Endianess for this architecture +# Endianness for this architecture ENDIANNESS=@endianness@ ### Name of architecture model for the native-code compiler. @@ -179,7 +179,9 @@ UNIXLIB=@unixlib@ INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@ OC_CFLAGS=@oc_cflags@ +CFLAGS?=@CFLAGS@ OC_CPPFLAGS=@oc_cppflags@ +CPPFLAGS?=@CPPFLAGS@ OCAMLC_CFLAGS=@ocamlc_cflags@ OCAMLC_CPPFLAGS=@ocamlc_cppflags@ @@ -252,10 +254,10 @@ 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) \ + MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) \ /link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE)) else - MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2) + MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2) endif # ifeq "$(TOOLCHAIN)" "msvc" # The following variables were defined only in the Windows-specific makefiles. diff --git a/README.adoc b/README.adoc index 1af0b7046..4f3bc7033 100644 --- a/README.adoc +++ b/README.adoc @@ -76,11 +76,10 @@ 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. +All files marked "Copyright INRIA" in this distribution are +Copyright (C) 1996-2020 Institut National de Recherche en Informatique et +en Automatique (INRIA) and distributed under the conditions stated in +file LICENSE. == Installation diff --git a/asmcomp/arm64/NOTES.md b/asmcomp/arm64/NOTES.md index e2134eb18..68ba2a5af 100644 --- a/asmcomp/arm64/NOTES.md +++ b/asmcomp/arm64/NOTES.md @@ -10,3 +10,4 @@ Debian architecture name: `arm64`. _ARM Architecture Reference Manual, ARMv8_, restricted to the AArch64 subset. * Application binary interface: _Procedure Call Standard for the ARM 64-bit Architecture (AArch64)_ + _Apple ARM64 Function Calling Conventions_ diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 96be20907..7bd4498e5 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -38,18 +38,35 @@ 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 +let reg_x8 = phys_reg 8 (* Output a label *) +let label_prefix = + if macosx then "L" else ".L" + let emit_label lbl = - emit_string ".L"; emit_int lbl + emit_string label_prefix; emit_int lbl (* Symbols *) let emit_symbol s = + if macosx then emit_string "_"; Emitaux.emit_symbol '$' s +(* Object types *) + +let emit_symbol_type emit_lbl_or_sym lbl_or_sym ty = + if not macosx then begin + ` .type {emit_lbl_or_sym lbl_or_sym}, %{emit_string ty}\n` + end + + +let emit_symbol_size sym = + if not macosx then begin + ` .size {emit_symbol sym}, .-{emit_symbol sym}\n` + end + (* Output a pseudo-register *) let emit_reg = function @@ -78,12 +95,15 @@ let prologue_required = ref false let contains_calls = ref false -let frame_size () = - let sz = - !stack_offset + +let initial_stack_offset () = 8 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + (if !contains_calls then 8 else 0) + +let frame_size () = + let sz = + !stack_offset + + initial_stack_offset () in Misc.align sz 16 let slot_offset loc cl = @@ -320,6 +340,8 @@ let float_literal f = (* Emit all pending literals *) let emit_literals() = if !float_literals <> [] then begin + if macosx then + ` .section __TEXT,__literal8,8byte_literals\n`; ` .align 3\n`; List.iter (fun (f, lbl) -> @@ -331,7 +353,10 @@ let emit_literals() = (* Emit code to load the address of a symbol *) let emit_load_symbol_addr dst s = - if not !Clflags.dlcode then begin + if macosx then begin + ` adrp {emit_reg dst}, {emit_symbol s}@GOTPAGE\n`; + ` ldr {emit_reg dst}, [{emit_reg dst}, {emit_symbol s}@GOTPAGEOFF]\n` + end else 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 @@ -427,7 +452,7 @@ module BR = Branch_relaxation.Make (struct let offset_pc_at_branch = 0 let prologue_size () = - (if frame_size () > 0 then 2 else 0) + (if initial_stack_offset () > 0 then 2 else 0) + (if !contains_calls then 1 else 0) let epilogue_size () = @@ -562,7 +587,7 @@ let assembly_code_for_allocation ~label_after_call_gc i ~n ~far ~dbginfo = | 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); + | _ -> emit_intconst reg_x8 (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` @@ -577,6 +602,17 @@ let emit_named_text_section func_name = else ` .text\n` +(* Emit code to load an emitted literal *) + +let emit_load_literal dst lbl = + if macosx then begin + ` adrp {emit_reg reg_tmp1}, {emit_label lbl}@PAGE\n`; + ` ldr {emit_reg dst}, [{emit_reg reg_tmp1}, {emit_label lbl}@PAGEOFF]\n` + end else begin + ` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`; + ` ldr {emit_reg dst}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n` + end + (* Output the assembly code for an instruction *) let emit_instr i = @@ -629,8 +665,7 @@ let emit_instr i = ` 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` + emit_load_literal i.res.(0) lbl end | Lop(Iconst_symbol s) -> emit_load_symbol_addr i.res.(0) s @@ -650,7 +685,7 @@ let emit_instr i = | 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; + emit_load_symbol_addr reg_x8 func; ` bl {emit_symbol "caml_c_call"}\n`; `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n` | Lop(Istackoffset n) -> @@ -950,7 +985,7 @@ let fundecl fundecl = 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_type emit_symbol fundecl.fun_name "function"; `{emit_symbol fundecl.fun_name}:\n`; emit_debug_info fundecl.fun_dbg; cfi_startproc(); @@ -968,8 +1003,8 @@ let fundecl fundecl = 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_symbol_type emit_symbol fundecl.fun_name "function"; + emit_symbol_size fundecl.fun_name; emit_literals() (* Emission of data *) @@ -1032,10 +1067,10 @@ let end_assembly () = `{emit_symbol lbl}:\n`; emit_frames { efa_code_label = (fun lbl -> - ` .type {emit_label lbl}, %function\n`; + emit_symbol_type emit_label lbl "function"; ` .quad {emit_label lbl}\n`); efa_data_label = (fun lbl -> - ` .type {emit_label lbl}, %object\n`; + emit_symbol_type emit_label lbl "object"; ` .quad {emit_label lbl}\n`); efa_8 = (fun n -> ` .byte {emit_int n}\n`); efa_16 = (fun n -> ` .short {emit_int n}\n`); @@ -1046,8 +1081,8 @@ let end_assembly () = ` .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`; + emit_symbol_type emit_symbol lbl "object"; + emit_symbol_size lbl; begin match Config.system with | "linux" -> (* Mark stack as non-executable *) diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml index f9c73f2fd..e259d2038 100644 --- a/asmcomp/arm64/proc.ml +++ b/asmcomp/arm64/proc.ml @@ -99,7 +99,7 @@ let all_phys_regs = 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_x8 = phys_reg 8 let reg_d7 = phys_reg 107 let stack_slot slot ty = @@ -165,13 +165,20 @@ let not_supported _ofs = fatal_error "Proc.loc_results: cannot call" Return values in r0...r15 or d0...d15. *) let max_arguments_for_tailcalls = 16 +let last_int_register = if macosx then 7 else 15 let loc_arguments arg = - calling_conventions 0 15 100 115 outgoing arg + calling_conventions 0 last_int_register 100 115 outgoing arg let loc_parameters arg = - let (loc, _) = calling_conventions 0 15 100 115 incoming arg in loc + let (loc, _) = + calling_conventions 0 last_int_register 100 115 incoming arg + in + loc let loc_results res = - let (loc, _) = calling_conventions 0 15 100 115 not_supported res in loc + let (loc, _) = + calling_conventions 0 last_int_register 100 115 not_supported res + in + loc (* C calling convention: first integer args in r0...r7 @@ -252,7 +259,7 @@ let destroyed_at_oper = function | Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call | Iop(Ialloc _) -> - [| reg_x15 |] + [| reg_x8 |] | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) -> [| reg_d7 |] (* d7 / s7 destroyed *) | _ -> [||] diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml index 8b1ce1b68..45305de73 100644 --- a/asmcomp/arm64/selection.ml +++ b/asmcomp/arm64/selection.ml @@ -83,7 +83,7 @@ let inline_ops = "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ] let use_direct_addressing _symb = - not !Clflags.dlcode + (not !Clflags.dlcode) && (not Arch.macosx) let is_stack_slot rv = Reg.(match rv with diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml index 5fd58924d..3594b9513 100644 --- a/asmcomp/cmm_helpers.ml +++ b/asmcomp/cmm_helpers.ml @@ -454,7 +454,7 @@ let rec div_int c1 c2 is_safe dbg = res = t + sign-bit(c1) *) bind "dividend" c1 (fun c1 -> - let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in + let t = Cop(Cmulhi, [c1; natint_const_untagged dbg m], 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 @@ -995,7 +995,7 @@ let sign_extend_32 dbg e = (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) + Cop(Cand, [low_32 dbg e; natint_const_untagged dbg 0xFFFFFFFFn], dbg) (* Boxed integers *) @@ -1074,21 +1074,23 @@ let unbox_int dbg bi = | 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) + natint_const_untagged dbg n | Some (Uconst_int32 n), Primitive.Pint32 -> - Cconst_natint (Nativeint.of_int32 n, dbg) + natint_const_untagged dbg (Nativeint.of_int32 n) | Some (Uconst_int64 n), Primitive.Pint64 -> if size_int = 8 then - Cconst_natint (Int64.to_nativeint n, dbg) + natint_const_untagged dbg (Int64.to_nativeint n) 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)] + Ctuple [natint_const_untagged dbg high; + natint_const_untagged dbg low] else - Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)] + Ctuple [natint_const_untagged dbg low; + natint_const_untagged dbg high] | _ -> default cmm end diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 5a28f5566..e06833881 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -42,14 +42,16 @@ let prologue_required = ref false let contains_calls = ref false +let initial_stack_offset () = + reserved_stack_space + + 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) + (* The return address *) 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 *) + initial_stack_offset () in Misc.align size 16 let slot_offset loc cls = @@ -439,7 +441,7 @@ module BR = Branch_relaxation.Make (struct let prologue_size () = profiling_prologue_size () - + (if frame_size () > 0 then 1 else 0) + + (if initial_stack_offset () > 0 then 1 else 0) + (if !contains_calls then 2 + match abi with diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml index 502cbb158..ce190a721 100644 --- a/asmcomp/riscv/proc.ml +++ b/asmcomp/riscv/proc.ml @@ -36,7 +36,8 @@ let word_addressed = false 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) + t0 21 temporary + t1 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) @@ -55,8 +56,8 @@ let word_addressed = false Additional notes ---------------- - - t0-t1 are used by the assembler and code generator, so - not available for register allocation. + - t1 is used by the 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 diff --git a/asmcomp/s390x/selection.ml b/asmcomp/s390x/selection.ml index 760719b51..be51e3838 100644 --- a/asmcomp/s390x/selection.ml +++ b/asmcomp/s390x/selection.ml @@ -80,6 +80,12 @@ method! select_operation op args dbg = match (op, args) with (* Z does not support immediate operands for multiply high *) (Cmulhi, _) -> (Iintop Imulh, args) + (* sub immediate is turned into add immediate opposite, + hence the immediate range is special *) + | (Csubi, [arg; Cconst_int (n, _)]) when self#is_immediate (-n) -> + (Iintop_imm(Isub, n), [arg]) + | (Csubi, _) -> + (Iintop Isub, args) (* The and, or and xor instructions have a different range of immediate operands than the other instructions *) | (Cand, _) -> diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index f70651877..5eb272010 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -1015,7 +1015,7 @@ method emit_extcall_args env ty_args args = method insert_move_extcall_arg env _ty_arg src dst = (* The default implementation is one or two ordinary moves. (Two in the case of an int64 argument on a 32-bit platform.) - It can be overriden to use special move instructions, + It can be overridden to use special move instructions, for example a "32-bit move" instruction for int32 arguments. *) self#insert_moves env src dst diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli index f0d9df03f..713567ca8 100644 --- a/asmcomp/selectgen.mli +++ b/asmcomp/selectgen.mli @@ -99,7 +99,7 @@ class virtual selector_generic : object or instructions with hardwired input/output registers *) method insert_move_extcall_arg : environment -> Cmm.exttype -> Reg.t array -> Reg.t array -> unit - (* Can be overriden to deal with unusual unboxed calling conventions, + (* Can be overridden to deal with unusual unboxed calling conventions, e.g. on a 64-bit platform, passing unboxed 32-bit arguments in 32-bit stack slots. *) method emit_extcall_args : diff --git a/asmcomp/spacetime_profiling.ml b/asmcomp/spacetime_profiling.ml index 9791026f4..696f2385a 100644 --- a/asmcomp/spacetime_profiling.ml +++ b/asmcomp/spacetime_profiling.ml @@ -33,7 +33,7 @@ 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_natint i = Cmm_helpers.natint_const_untagged Debuginfo.none i let cconst_symbol s = Cmm.Cconst_symbol (s, Debuginfo.none) let something_was_instrumented () = diff --git a/boot/menhir/parser.ml b/boot/menhir/parser.ml index a643300db..afe5e6132 100644 --- a/boot/menhir/parser.ml +++ b/boot/menhir/parser.ml @@ -16,7 +16,7 @@ module MenhirBasics = struct | VAL | UNDERSCORE | UIDENT of ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) # 22 "parsing/parser.ml" ) @@ -28,7 +28,7 @@ module MenhirBasics = struct | THEN | STRUCT | STRING of ( -# 685 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string * Location.t * string option) # 34 "parsing/parser.ml" ) @@ -41,12 +41,12 @@ module MenhirBasics = struct | RBRACKET | RBRACE | QUOTED_STRING_ITEM of ( -# 689 "parsing/parser.mly" +# 692 "parsing/parser.mly" (string * Location.t * string * Location.t * string option) # 47 "parsing/parser.ml" ) | QUOTED_STRING_EXPR of ( -# 687 "parsing/parser.mly" +# 690 "parsing/parser.mly" (string * Location.t * string * Location.t * string option) # 52 "parsing/parser.ml" ) @@ -54,7 +54,7 @@ module MenhirBasics = struct | QUESTION | PRIVATE | PREFIXOP of ( -# 671 "parsing/parser.mly" +# 674 "parsing/parser.mly" (string) # 60 "parsing/parser.ml" ) @@ -64,7 +64,7 @@ module MenhirBasics = struct | PERCENT | OR | OPTLABEL of ( -# 664 "parsing/parser.mly" +# 667 "parsing/parser.mly" (string) # 70 "parsing/parser.ml" ) @@ -82,12 +82,12 @@ module MenhirBasics = struct | MATCH | LPAREN | LIDENT of ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) # 88 "parsing/parser.ml" ) | LETOP of ( -# 629 "parsing/parser.mly" +# 632 "parsing/parser.mly" (string) # 93 "parsing/parser.ml" ) @@ -107,39 +107,39 @@ module MenhirBasics = struct | LBRACE | LAZY | LABEL of ( -# 634 "parsing/parser.mly" +# 637 "parsing/parser.mly" (string) # 113 "parsing/parser.ml" ) | INT of ( -# 633 "parsing/parser.mly" +# 636 "parsing/parser.mly" (string * char option) # 118 "parsing/parser.ml" ) | INITIALIZER | INHERIT | INFIXOP4 of ( -# 627 "parsing/parser.mly" +# 630 "parsing/parser.mly" (string) # 125 "parsing/parser.ml" ) | INFIXOP3 of ( -# 626 "parsing/parser.mly" +# 629 "parsing/parser.mly" (string) # 130 "parsing/parser.ml" ) | INFIXOP2 of ( -# 625 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string) # 135 "parsing/parser.ml" ) | INFIXOP1 of ( -# 624 "parsing/parser.mly" +# 627 "parsing/parser.mly" (string) # 140 "parsing/parser.ml" ) | INFIXOP0 of ( -# 623 "parsing/parser.mly" +# 626 "parsing/parser.mly" (string) # 145 "parsing/parser.ml" ) @@ -147,7 +147,7 @@ module MenhirBasics = struct | IN | IF | HASHOP of ( -# 682 "parsing/parser.mly" +# 685 "parsing/parser.mly" (string) # 153 "parsing/parser.ml" ) @@ -160,7 +160,7 @@ module MenhirBasics = struct | FUN | FOR | FLOAT of ( -# 612 "parsing/parser.mly" +# 615 "parsing/parser.mly" (string * char option) # 166 "parsing/parser.ml" ) @@ -174,7 +174,7 @@ module MenhirBasics = struct | ELSE | DOWNTO | DOTOP of ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) # 180 "parsing/parser.ml" ) @@ -182,14 +182,14 @@ module MenhirBasics = struct | DOT | DONE | DOCSTRING of ( -# 705 "parsing/parser.mly" +# 708 "parsing/parser.mly" (Docstrings.docstring) # 188 "parsing/parser.ml" ) | DO | CONSTRAINT | COMMENT of ( -# 704 "parsing/parser.mly" +# 707 "parsing/parser.mly" (string * Location.t) # 195 "parsing/parser.ml" ) @@ -200,7 +200,7 @@ module MenhirBasics = struct | COLON | CLASS | CHAR of ( -# 592 "parsing/parser.mly" +# 595 "parsing/parser.mly" (char) # 206 "parsing/parser.ml" ) @@ -213,7 +213,7 @@ module MenhirBasics = struct | ASSERT | AS | ANDOP of ( -# 630 "parsing/parser.mly" +# 633 "parsing/parser.mly" (string) # 219 "parsing/parser.ml" ) @@ -641,7 +641,8 @@ 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 text_def pos = + List.map (fun def -> Ptop_def [def]) (Str.text (rhs_text pos)) let extra_text startpos endpos text items = match items with @@ -659,7 +660,9 @@ 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 + extra_text p1 p2 + (fun txt -> List.map (fun def -> Ptop_def [def]) (Str.text txt)) + items let extra_rhs_core_type ct ~pos = let docs = rhs_info pos in @@ -789,7 +792,7 @@ let mk_directive ~loc name arg = } -# 793 "parsing/parser.ml" +# 796 "parsing/parser.ml" module Tables = struct @@ -1332,9 +1335,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3652 "parsing/parser.mly" +# 3655 "parsing/parser.mly" ( "+" ) -# 1338 "parsing/parser.ml" +# 1341 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1357,9 +1360,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3653 "parsing/parser.mly" +# 3656 "parsing/parser.mly" ( "+." ) -# 1363 "parsing/parser.ml" +# 1366 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1382,9 +1385,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = -# 3209 "parsing/parser.mly" +# 3212 "parsing/parser.mly" ( _1 ) -# 1388 "parsing/parser.ml" +# 1391 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1429,24 +1432,24 @@ module Tables = struct let _endpos = _endpos_tyvar_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3212 "parsing/parser.mly" +# 3215 "parsing/parser.mly" ( Ptyp_alias(ty, tyvar) ) -# 1435 "parsing/parser.ml" +# 1438 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1444 "parsing/parser.ml" +# 1447 "parsing/parser.ml" in -# 3214 "parsing/parser.mly" +# 3217 "parsing/parser.mly" ( _1 ) -# 1450 "parsing/parser.ml" +# 1453 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1492,30 +1495,30 @@ module Tables = struct let _v : (let_binding) = let attrs2 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 1498 "parsing/parser.ml" +# 1501 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 1507 "parsing/parser.ml" +# 1510 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2478 "parsing/parser.mly" +# 2481 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklb ~loc:_sloc false body attrs ) -# 1519 "parsing/parser.ml" +# 1522 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1538,9 +1541,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3539 "parsing/parser.mly" +# 3542 "parsing/parser.mly" ( _1 ) -# 1544 "parsing/parser.ml" +# 1547 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1563,9 +1566,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3540 "parsing/parser.mly" +# 3543 "parsing/parser.mly" ( Lident _1 ) -# 1569 "parsing/parser.ml" +# 1572 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1602,9 +1605,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = -# 3270 "parsing/parser.mly" +# 3273 "parsing/parser.mly" ( _2 ) -# 1608 "parsing/parser.ml" +# 1611 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1667,11 +1670,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 1675 "parsing/parser.ml" +# 1678 "parsing/parser.ml" in let _3 = @@ -1679,24 +1682,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 1685 "parsing/parser.ml" +# 1688 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 1691 "parsing/parser.ml" +# 1694 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3272 "parsing/parser.mly" +# 3275 "parsing/parser.mly" ( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 ) -# 1700 "parsing/parser.ml" +# 1703 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1727,24 +1730,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3275 "parsing/parser.mly" +# 3278 "parsing/parser.mly" ( Ptyp_var _2 ) -# 1733 "parsing/parser.ml" +# 1736 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1742 "parsing/parser.ml" +# 1745 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 1748 "parsing/parser.ml" +# 1751 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1768,23 +1771,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3277 "parsing/parser.mly" +# 3280 "parsing/parser.mly" ( Ptyp_any ) -# 1774 "parsing/parser.ml" +# 1777 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1782 "parsing/parser.ml" +# 1785 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 1788 "parsing/parser.ml" +# 1791 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1813,35 +1816,35 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1819 "parsing/parser.ml" +# 1822 "parsing/parser.ml" in let tys = -# 3322 "parsing/parser.mly" +# 3325 "parsing/parser.mly" ( [] ) -# 1825 "parsing/parser.ml" +# 1828 "parsing/parser.ml" in -# 3280 "parsing/parser.mly" +# 3283 "parsing/parser.mly" ( Ptyp_constr(tid, tys) ) -# 1830 "parsing/parser.ml" +# 1833 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1839 "parsing/parser.ml" +# 1842 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 1845 "parsing/parser.ml" +# 1848 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1877,20 +1880,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1883 "parsing/parser.ml" +# 1886 "parsing/parser.ml" in let tys = -# 3324 "parsing/parser.mly" +# 3327 "parsing/parser.mly" ( [ty] ) -# 1889 "parsing/parser.ml" +# 1892 "parsing/parser.ml" in -# 3280 "parsing/parser.mly" +# 3283 "parsing/parser.mly" ( Ptyp_constr(tid, tys) ) -# 1894 "parsing/parser.ml" +# 1897 "parsing/parser.ml" in let _startpos__1_ = _startpos_ty_ in @@ -1898,15 +1901,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1904 "parsing/parser.ml" +# 1907 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 1910 "parsing/parser.ml" +# 1913 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1957,9 +1960,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1963 "parsing/parser.ml" +# 1966 "parsing/parser.ml" in let tys = @@ -1967,24 +1970,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 1971 "parsing/parser.ml" +# 1974 "parsing/parser.ml" in -# 975 "parsing/parser.mly" +# 978 "parsing/parser.mly" ( xs ) -# 1976 "parsing/parser.ml" +# 1979 "parsing/parser.ml" in -# 3326 "parsing/parser.mly" +# 3329 "parsing/parser.mly" ( tys ) -# 1982 "parsing/parser.ml" +# 1985 "parsing/parser.ml" in -# 3280 "parsing/parser.mly" +# 3283 "parsing/parser.mly" ( Ptyp_constr(tid, tys) ) -# 1988 "parsing/parser.ml" +# 1991 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -1992,15 +1995,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1998 "parsing/parser.ml" +# 2001 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2004 "parsing/parser.ml" +# 2007 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2038,24 +2041,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3282 "parsing/parser.mly" +# 3285 "parsing/parser.mly" ( let (f, c) = _2 in Ptyp_object (f, c) ) -# 2044 "parsing/parser.ml" +# 2047 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2053 "parsing/parser.ml" +# 2056 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2059 "parsing/parser.ml" +# 2062 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2086,24 +2089,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3284 "parsing/parser.mly" +# 3287 "parsing/parser.mly" ( Ptyp_object ([], Closed) ) -# 2092 "parsing/parser.ml" +# 2095 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2101 "parsing/parser.ml" +# 2104 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2107 "parsing/parser.ml" +# 2110 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2139,20 +2142,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2145 "parsing/parser.ml" +# 2148 "parsing/parser.ml" in let tys = -# 3322 "parsing/parser.mly" +# 3325 "parsing/parser.mly" ( [] ) -# 2151 "parsing/parser.ml" +# 2154 "parsing/parser.ml" in -# 3288 "parsing/parser.mly" +# 3291 "parsing/parser.mly" ( Ptyp_class(cid, tys) ) -# 2156 "parsing/parser.ml" +# 2159 "parsing/parser.ml" in let _startpos__1_ = _startpos__2_ in @@ -2160,15 +2163,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2166 "parsing/parser.ml" +# 2169 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2172 "parsing/parser.ml" +# 2175 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2211,20 +2214,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2217 "parsing/parser.ml" +# 2220 "parsing/parser.ml" in let tys = -# 3324 "parsing/parser.mly" +# 3327 "parsing/parser.mly" ( [ty] ) -# 2223 "parsing/parser.ml" +# 2226 "parsing/parser.ml" in -# 3288 "parsing/parser.mly" +# 3291 "parsing/parser.mly" ( Ptyp_class(cid, tys) ) -# 2228 "parsing/parser.ml" +# 2231 "parsing/parser.ml" in let _startpos__1_ = _startpos_ty_ in @@ -2232,15 +2235,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2238 "parsing/parser.ml" +# 2241 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2244 "parsing/parser.ml" +# 2247 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2298,9 +2301,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2304 "parsing/parser.ml" +# 2307 "parsing/parser.ml" in let tys = @@ -2308,24 +2311,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2312 "parsing/parser.ml" +# 2315 "parsing/parser.ml" in -# 975 "parsing/parser.mly" +# 978 "parsing/parser.mly" ( xs ) -# 2317 "parsing/parser.ml" +# 2320 "parsing/parser.ml" in -# 3326 "parsing/parser.mly" +# 3329 "parsing/parser.mly" ( tys ) -# 2323 "parsing/parser.ml" +# 2326 "parsing/parser.ml" in -# 3288 "parsing/parser.mly" +# 3291 "parsing/parser.mly" ( Ptyp_class(cid, tys) ) -# 2329 "parsing/parser.ml" +# 2332 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -2333,15 +2336,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2339 "parsing/parser.ml" +# 2342 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2345 "parsing/parser.ml" +# 2348 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2379,24 +2382,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3291 "parsing/parser.mly" +# 3294 "parsing/parser.mly" ( Ptyp_variant([_2], Closed, None) ) -# 2385 "parsing/parser.ml" +# 2388 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2394 "parsing/parser.ml" +# 2397 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2400 "parsing/parser.ml" +# 2403 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2446,24 +2449,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2450 "parsing/parser.ml" +# 2453 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 2455 "parsing/parser.ml" +# 2458 "parsing/parser.ml" in -# 3336 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( _1 ) -# 2461 "parsing/parser.ml" +# 2464 "parsing/parser.ml" in -# 3293 "parsing/parser.mly" +# 3296 "parsing/parser.mly" ( Ptyp_variant(_3, Closed, None) ) -# 2467 "parsing/parser.ml" +# 2470 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -2471,15 +2474,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2477 "parsing/parser.ml" +# 2480 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2483 "parsing/parser.ml" +# 2486 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2536,24 +2539,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2540 "parsing/parser.ml" +# 2543 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 2545 "parsing/parser.ml" +# 2548 "parsing/parser.ml" in -# 3336 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( _1 ) -# 2551 "parsing/parser.ml" +# 2554 "parsing/parser.ml" in -# 3295 "parsing/parser.mly" +# 3298 "parsing/parser.mly" ( Ptyp_variant(_2 :: _4, Closed, None) ) -# 2557 "parsing/parser.ml" +# 2560 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -2561,15 +2564,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2567 "parsing/parser.ml" +# 2570 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2573 "parsing/parser.ml" +# 2576 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2619,24 +2622,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2623 "parsing/parser.ml" +# 2626 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 2628 "parsing/parser.ml" +# 2631 "parsing/parser.ml" in -# 3336 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( _1 ) -# 2634 "parsing/parser.ml" +# 2637 "parsing/parser.ml" in -# 3297 "parsing/parser.mly" +# 3300 "parsing/parser.mly" ( Ptyp_variant(_3, Open, None) ) -# 2640 "parsing/parser.ml" +# 2643 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -2644,15 +2647,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2650 "parsing/parser.ml" +# 2653 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2656 "parsing/parser.ml" +# 2659 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2683,24 +2686,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3299 "parsing/parser.mly" +# 3302 "parsing/parser.mly" ( Ptyp_variant([], Open, None) ) -# 2689 "parsing/parser.ml" +# 2692 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2698 "parsing/parser.ml" +# 2701 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2704 "parsing/parser.ml" +# 2707 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2750,24 +2753,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2754 "parsing/parser.ml" +# 2757 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 2759 "parsing/parser.ml" +# 2762 "parsing/parser.ml" in -# 3336 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( _1 ) -# 2765 "parsing/parser.ml" +# 2768 "parsing/parser.ml" in -# 3301 "parsing/parser.mly" +# 3304 "parsing/parser.mly" ( Ptyp_variant(_3, Closed, Some []) ) -# 2771 "parsing/parser.ml" +# 2774 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -2775,15 +2778,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2781 "parsing/parser.ml" +# 2784 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2787 "parsing/parser.ml" +# 2790 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2848,18 +2851,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2852 "parsing/parser.ml" +# 2855 "parsing/parser.ml" in -# 915 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 2857 "parsing/parser.ml" +# 2860 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3367 "parsing/parser.mly" ( _1 ) -# 2863 "parsing/parser.ml" +# 2866 "parsing/parser.ml" in let _3 = @@ -2867,24 +2870,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 2871 "parsing/parser.ml" +# 2874 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 2876 "parsing/parser.ml" +# 2879 "parsing/parser.ml" in -# 3336 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( _1 ) -# 2882 "parsing/parser.ml" +# 2885 "parsing/parser.ml" in -# 3303 "parsing/parser.mly" +# 3306 "parsing/parser.mly" ( Ptyp_variant(_3, Closed, Some _5) ) -# 2888 "parsing/parser.ml" +# 2891 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -2892,15 +2895,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2898 "parsing/parser.ml" +# 2901 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2904 "parsing/parser.ml" +# 2907 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2924,23 +2927,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3305 "parsing/parser.mly" +# 3308 "parsing/parser.mly" ( Ptyp_extension _1 ) -# 2930 "parsing/parser.ml" +# 2933 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2938 "parsing/parser.ml" +# 2941 "parsing/parser.ml" in -# 3307 "parsing/parser.mly" +# 3310 "parsing/parser.mly" ( _1 ) -# 2944 "parsing/parser.ml" +# 2947 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2964,23 +2967,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string Asttypes.loc) = let _1 = let _1 = -# 3719 "parsing/parser.mly" +# 3722 "parsing/parser.mly" ( _1 ) -# 2970 "parsing/parser.ml" +# 2973 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 843 "parsing/parser.mly" +# 846 "parsing/parser.mly" ( mkloc _1 (make_loc _sloc) ) -# 2978 "parsing/parser.ml" +# 2981 "parsing/parser.ml" in -# 3721 "parsing/parser.mly" +# 3724 "parsing/parser.mly" ( _1 ) -# 2984 "parsing/parser.ml" +# 2987 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3018,24 +3021,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (string Asttypes.loc) = let _1 = let _1 = -# 3720 "parsing/parser.mly" +# 3723 "parsing/parser.mly" ( _1 ^ "." ^ _3.txt ) -# 3024 "parsing/parser.ml" +# 3027 "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" +# 846 "parsing/parser.mly" ( mkloc _1 (make_loc _sloc) ) -# 3033 "parsing/parser.ml" +# 3036 "parsing/parser.ml" in -# 3721 "parsing/parser.mly" +# 3724 "parsing/parser.mly" ( _1 ) -# 3039 "parsing/parser.ml" +# 3042 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3082,9 +3085,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3725 "parsing/parser.mly" +# 3728 "parsing/parser.mly" ( Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 3088 "parsing/parser.ml" +# 3091 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3107,9 +3110,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.class_expr) = -# 1762 "parsing/parser.mly" +# 1765 "parsing/parser.mly" ( _1 ) -# 3113 "parsing/parser.ml" +# 3116 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3148,18 +3151,18 @@ module Tables = struct let _v : (Parsetree.class_expr) = let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3154 "parsing/parser.ml" +# 3157 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1764 "parsing/parser.mly" +# 1767 "parsing/parser.mly" ( wrap_class_attrs ~loc:_sloc _3 _2 ) -# 3163 "parsing/parser.ml" +# 3166 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3199,9 +3202,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1766 "parsing/parser.mly" +# 1769 "parsing/parser.mly" ( class_of_let_bindings ~loc:_sloc _1 _3 ) -# 3205 "parsing/parser.ml" +# 3208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3264,34 +3267,34 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 3270 "parsing/parser.ml" +# 3273 "parsing/parser.ml" in let _4 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3278 "parsing/parser.ml" +# 3281 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined1_ in let _3 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 3285 "parsing/parser.ml" +# 3288 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1768 "parsing/parser.mly" +# 1771 "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)) ) -# 3295 "parsing/parser.ml" +# 3298 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3361,37 +3364,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 3367 "parsing/parser.ml" +# 3370 "parsing/parser.ml" in let _4 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3375 "parsing/parser.ml" +# 3378 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 3384 "parsing/parser.ml" +# 3387 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1768 "parsing/parser.mly" +# 1771 "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)) ) -# 3395 "parsing/parser.ml" +# 3398 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3421,9 +3424,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.class_expr) = -# 1772 "parsing/parser.mly" +# 1775 "parsing/parser.mly" ( Cl.attr _1 _2 ) -# 3427 "parsing/parser.ml" +# 3430 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3458,18 +3461,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 3462 "parsing/parser.ml" +# 3465 "parsing/parser.ml" in -# 915 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 3467 "parsing/parser.ml" +# 3470 "parsing/parser.ml" in -# 1775 "parsing/parser.mly" +# 1778 "parsing/parser.mly" ( Pcl_apply(_1, _2) ) -# 3473 "parsing/parser.ml" +# 3476 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -3477,15 +3480,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 866 "parsing/parser.mly" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3483 "parsing/parser.ml" +# 3486 "parsing/parser.ml" in -# 1778 "parsing/parser.mly" +# 1781 "parsing/parser.mly" ( _1 ) -# 3489 "parsing/parser.ml" +# 3492 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3509,23 +3512,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1777 "parsing/parser.mly" +# 1780 "parsing/parser.mly" ( Pcl_extension _1 ) -# 3515 "parsing/parser.ml" +# 3518 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 866 "parsing/parser.mly" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3523 "parsing/parser.ml" +# 3526 "parsing/parser.ml" in -# 1778 "parsing/parser.mly" +# 1781 "parsing/parser.mly" ( _1 ) -# 3529 "parsing/parser.ml" +# 3532 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3578,33 +3581,33 @@ module Tables = struct let _v : (Parsetree.class_field) = let _6 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3584 "parsing/parser.ml" +# 3587 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3593 "parsing/parser.ml" +# 3596 "parsing/parser.ml" in let _2 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 3599 "parsing/parser.ml" +# 3602 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1827 "parsing/parser.mly" +# 1830 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs ) -# 3608 "parsing/parser.ml" +# 3611 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3664,36 +3667,36 @@ module Tables = struct let _v : (Parsetree.class_field) = let _6 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3670 "parsing/parser.ml" +# 3673 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in let _3 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3679 "parsing/parser.ml" +# 3682 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 3687 "parsing/parser.ml" +# 3690 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1827 "parsing/parser.mly" +# 1830 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs ) -# 3697 "parsing/parser.ml" +# 3700 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3734,9 +3737,9 @@ module Tables = struct let _v : (Parsetree.class_field) = let _3 = let _1 = _1_inlined1 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3740 "parsing/parser.ml" +# 3743 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -3744,11 +3747,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1830 "parsing/parser.mly" +# 1833 "parsing/parser.mly" ( let v, attrs = _2 in let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs ) -# 3752 "parsing/parser.ml" +# 3755 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3789,9 +3792,9 @@ module Tables = struct let _v : (Parsetree.class_field) = let _3 = let _1 = _1_inlined1 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3795 "parsing/parser.ml" +# 3798 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -3799,11 +3802,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1834 "parsing/parser.mly" +# 1837 "parsing/parser.mly" ( let meth, attrs = _2 in let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs ) -# 3807 "parsing/parser.ml" +# 3810 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3849,28 +3852,28 @@ module Tables = struct let _v : (Parsetree.class_field) = let _4 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3855 "parsing/parser.ml" +# 3858 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3864 "parsing/parser.ml" +# 3867 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1838 "parsing/parser.mly" +# 1841 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs ) -# 3874 "parsing/parser.ml" +# 3877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3916,28 +3919,28 @@ module Tables = struct let _v : (Parsetree.class_field) = let _4 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3922 "parsing/parser.ml" +# 3925 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 3931 "parsing/parser.ml" +# 3934 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1841 "parsing/parser.mly" +# 1844 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs ) -# 3941 "parsing/parser.ml" +# 3944 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3969,9 +3972,9 @@ module Tables = struct let _v : (Parsetree.class_field) = let _2 = let _1 = _1_inlined1 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 3975 "parsing/parser.ml" +# 3978 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -3979,10 +3982,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1844 "parsing/parser.mly" +# 1847 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs ) -# 3986 "parsing/parser.ml" +# 3989 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4006,23 +4009,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_field) = let _1 = let _1 = -# 1847 "parsing/parser.mly" +# 1850 "parsing/parser.mly" ( Pcf_attribute _1 ) -# 4012 "parsing/parser.ml" +# 4015 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 864 "parsing/parser.mly" +# 867 "parsing/parser.mly" ( mkcf ~loc:_sloc _1 ) -# 4020 "parsing/parser.ml" +# 4023 "parsing/parser.ml" in -# 1848 "parsing/parser.mly" +# 1851 "parsing/parser.mly" ( _1 ) -# 4026 "parsing/parser.ml" +# 4029 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4052,9 +4055,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.class_expr) = -# 1742 "parsing/parser.mly" +# 1745 "parsing/parser.mly" ( _2 ) -# 4058 "parsing/parser.ml" +# 4061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4099,24 +4102,24 @@ module Tables = struct let _endpos = _endpos__4_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1745 "parsing/parser.mly" +# 1748 "parsing/parser.mly" ( Pcl_constraint(_4, _2) ) -# 4105 "parsing/parser.ml" +# 4108 "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" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4114 "parsing/parser.ml" +# 4117 "parsing/parser.ml" in -# 1748 "parsing/parser.mly" +# 1751 "parsing/parser.mly" ( _1 ) -# 4120 "parsing/parser.ml" +# 4123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4147,24 +4150,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1747 "parsing/parser.mly" +# 1750 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) ) -# 4153 "parsing/parser.ml" +# 4156 "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" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4162 "parsing/parser.ml" +# 4165 "parsing/parser.ml" in -# 1748 "parsing/parser.mly" +# 1751 "parsing/parser.mly" ( _1 ) -# 4168 "parsing/parser.ml" +# 4171 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4202,24 +4205,24 @@ module Tables = struct let _endpos = _endpos_e_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1803 "parsing/parser.mly" +# 1806 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) ) -# 4208 "parsing/parser.ml" +# 4211 "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" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4217 "parsing/parser.ml" +# 4220 "parsing/parser.ml" in -# 1804 "parsing/parser.mly" +# 1807 "parsing/parser.mly" ( _1 ) -# 4223 "parsing/parser.ml" +# 4226 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4250,24 +4253,24 @@ module Tables = struct let _endpos = _endpos_e_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1803 "parsing/parser.mly" +# 1806 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) ) -# 4256 "parsing/parser.ml" +# 4259 "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" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4265 "parsing/parser.ml" +# 4268 "parsing/parser.ml" in -# 1804 "parsing/parser.mly" +# 1807 "parsing/parser.mly" ( _1 ) -# 4271 "parsing/parser.ml" +# 4274 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4290,9 +4293,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3530 "parsing/parser.mly" +# 3533 "parsing/parser.mly" ( _1 ) -# 4296 "parsing/parser.ml" +# 4299 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4332,9 +4335,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1812 "parsing/parser.mly" +# 1815 "parsing/parser.mly" ( reloc_pat ~loc:_sloc _2 ) -# 4338 "parsing/parser.ml" +# 4341 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4386,24 +4389,24 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 1814 "parsing/parser.mly" +# 1817 "parsing/parser.mly" ( Ppat_constraint(_2, _4) ) -# 4392 "parsing/parser.ml" +# 4395 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 4401 "parsing/parser.ml" +# 4404 "parsing/parser.ml" in -# 1815 "parsing/parser.mly" +# 1818 "parsing/parser.mly" ( _1 ) -# 4407 "parsing/parser.ml" +# 4410 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4422,9 +4425,9 @@ module Tables = struct let _symbolstartpos = _endpos in let _sloc = (_symbolstartpos, _endpos) in -# 1817 "parsing/parser.mly" +# 1820 "parsing/parser.mly" ( ghpat ~loc:_sloc Ppat_any ) -# 4428 "parsing/parser.ml" +# 4431 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4461,9 +4464,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = -# 1942 "parsing/parser.mly" +# 1945 "parsing/parser.mly" ( _2 ) -# 4467 "parsing/parser.ml" +# 4470 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4480,24 +4483,24 @@ module Tables = struct let _endpos = _startpos in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 1943 "parsing/parser.mly" +# 1946 "parsing/parser.mly" ( Ptyp_any ) -# 4486 "parsing/parser.ml" +# 4489 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 4495 "parsing/parser.ml" +# 4498 "parsing/parser.ml" in -# 1944 "parsing/parser.mly" +# 1947 "parsing/parser.mly" ( _1 ) -# 4501 "parsing/parser.ml" +# 4504 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4543,28 +4546,28 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _4 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 4549 "parsing/parser.ml" +# 4552 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 4558 "parsing/parser.ml" +# 4561 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1952 "parsing/parser.mly" +# 1955 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs ) -# 4568 "parsing/parser.ml" +# 4571 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4622,9 +4625,9 @@ module Tables = struct let ty : (Parsetree.core_type) = Obj.magic ty in let _3 : unit = Obj.magic _3 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 4628 "parsing/parser.ml" +# 4631 "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 @@ -4635,9 +4638,9 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _4 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 4641 "parsing/parser.ml" +# 4644 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined3_ in @@ -4645,44 +4648,44 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let label = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 4651 "parsing/parser.ml" +# 4654 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4659 "parsing/parser.ml" +# 4662 "parsing/parser.ml" in -# 1977 "parsing/parser.mly" +# 1980 "parsing/parser.mly" ( let mut, virt = flags in label, mut, virt, ty ) -# 4668 "parsing/parser.ml" +# 4671 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 4676 "parsing/parser.ml" +# 4679 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1955 "parsing/parser.mly" +# 1958 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs ) -# 4686 "parsing/parser.ml" +# 4689 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4740,9 +4743,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 4746 "parsing/parser.ml" +# 4749 "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 @@ -4753,53 +4756,53 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _7 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 4759 "parsing/parser.ml" +# 4762 "parsing/parser.ml" in let _endpos__7_ = _endpos__1_inlined4_ in let _6 = let _1 = _1_inlined3 in -# 3175 "parsing/parser.mly" +# 3178 "parsing/parser.mly" ( _1 ) -# 4768 "parsing/parser.ml" +# 4771 "parsing/parser.ml" in let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 4776 "parsing/parser.ml" +# 4779 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4784 "parsing/parser.ml" +# 4787 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 4792 "parsing/parser.ml" +# 4795 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1959 "parsing/parser.mly" +# 1962 "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 ) -# 4803 "parsing/parser.ml" +# 4806 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4845,28 +4848,28 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _4 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 4851 "parsing/parser.ml" +# 4854 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 4860 "parsing/parser.ml" +# 4863 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1963 "parsing/parser.mly" +# 1966 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs ) -# 4870 "parsing/parser.ml" +# 4873 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4898,9 +4901,9 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _2 = let _1 = _1_inlined1 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 4904 "parsing/parser.ml" +# 4907 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -4908,10 +4911,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1966 "parsing/parser.mly" +# 1969 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs ) -# 4915 "parsing/parser.ml" +# 4918 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4935,23 +4938,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_type_field) = let _1 = let _1 = -# 1969 "parsing/parser.mly" +# 1972 "parsing/parser.mly" ( Pctf_attribute _1 ) -# 4941 "parsing/parser.ml" +# 4944 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 862 "parsing/parser.mly" +# 865 "parsing/parser.mly" ( mkctf ~loc:_sloc _1 ) -# 4949 "parsing/parser.ml" +# 4952 "parsing/parser.ml" in -# 1970 "parsing/parser.mly" +# 1973 "parsing/parser.mly" ( _1 ) -# 4955 "parsing/parser.ml" +# 4958 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4980,42 +4983,42 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4986 "parsing/parser.ml" +# 4989 "parsing/parser.ml" in let tys = let tys = -# 1928 "parsing/parser.mly" +# 1931 "parsing/parser.mly" ( [] ) -# 4993 "parsing/parser.ml" +# 4996 "parsing/parser.ml" in -# 1934 "parsing/parser.mly" +# 1937 "parsing/parser.mly" ( tys ) -# 4998 "parsing/parser.ml" +# 5001 "parsing/parser.ml" in -# 1911 "parsing/parser.mly" +# 1914 "parsing/parser.mly" ( Pcty_constr (cid, tys) ) -# 5004 "parsing/parser.ml" +# 5007 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 860 "parsing/parser.mly" +# 863 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5013 "parsing/parser.ml" +# 5016 "parsing/parser.ml" in -# 1914 "parsing/parser.mly" +# 1917 "parsing/parser.mly" ( _1 ) -# 5019 "parsing/parser.ml" +# 5022 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5066,9 +5069,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5072 "parsing/parser.ml" +# 5075 "parsing/parser.ml" in let tys = @@ -5077,30 +5080,30 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 5081 "parsing/parser.ml" +# 5084 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 5086 "parsing/parser.ml" +# 5089 "parsing/parser.ml" in -# 1930 "parsing/parser.mly" +# 1933 "parsing/parser.mly" ( params ) -# 5092 "parsing/parser.ml" +# 5095 "parsing/parser.ml" in -# 1934 "parsing/parser.mly" +# 1937 "parsing/parser.mly" ( tys ) -# 5098 "parsing/parser.ml" +# 5101 "parsing/parser.ml" in -# 1911 "parsing/parser.mly" +# 1914 "parsing/parser.mly" ( Pcty_constr (cid, tys) ) -# 5104 "parsing/parser.ml" +# 5107 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -5108,15 +5111,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 860 "parsing/parser.mly" +# 863 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5114 "parsing/parser.ml" +# 5117 "parsing/parser.ml" in -# 1914 "parsing/parser.mly" +# 1917 "parsing/parser.mly" ( _1 ) -# 5120 "parsing/parser.ml" +# 5123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5140,23 +5143,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_type) = let _1 = let _1 = -# 1913 "parsing/parser.mly" +# 1916 "parsing/parser.mly" ( Pcty_extension _1 ) -# 5146 "parsing/parser.ml" +# 5149 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 860 "parsing/parser.mly" +# 863 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5154 "parsing/parser.ml" +# 5157 "parsing/parser.ml" in -# 1914 "parsing/parser.mly" +# 1917 "parsing/parser.mly" ( _1 ) -# 5160 "parsing/parser.ml" +# 5163 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5213,44 +5216,44 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 5217 "parsing/parser.ml" +# 5220 "parsing/parser.ml" in -# 1948 "parsing/parser.mly" +# 1951 "parsing/parser.mly" ( _1 ) -# 5222 "parsing/parser.ml" +# 5225 "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" +# 811 "parsing/parser.mly" ( extra_csig _startpos _endpos _1 ) -# 5231 "parsing/parser.ml" +# 5234 "parsing/parser.ml" in -# 1938 "parsing/parser.mly" +# 1941 "parsing/parser.mly" ( Csig.mk _1 _2 ) -# 5237 "parsing/parser.ml" +# 5240 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 5245 "parsing/parser.ml" +# 5248 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1916 "parsing/parser.mly" +# 1919 "parsing/parser.mly" ( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) ) -# 5254 "parsing/parser.ml" +# 5257 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5307,43 +5310,43 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 5311 "parsing/parser.ml" +# 5314 "parsing/parser.ml" in -# 1948 "parsing/parser.mly" +# 1951 "parsing/parser.mly" ( _1 ) -# 5316 "parsing/parser.ml" +# 5319 "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" +# 811 "parsing/parser.mly" ( extra_csig _startpos _endpos _1 ) -# 5325 "parsing/parser.ml" +# 5328 "parsing/parser.ml" in -# 1938 "parsing/parser.mly" +# 1941 "parsing/parser.mly" ( Csig.mk _1 _2 ) -# 5331 "parsing/parser.ml" +# 5334 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 5339 "parsing/parser.ml" +# 5342 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1918 "parsing/parser.mly" +# 1921 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 5347 "parsing/parser.ml" +# 5350 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5373,9 +5376,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.class_type) = -# 1920 "parsing/parser.mly" +# 1923 "parsing/parser.mly" ( Cty.attr _1 _2 ) -# 5379 "parsing/parser.ml" +# 5382 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5438,34 +5441,34 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5444 "parsing/parser.ml" +# 5447 "parsing/parser.ml" in let _4 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 5452 "parsing/parser.ml" +# 5455 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined1_ in let _3 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 5459 "parsing/parser.ml" +# 5462 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1922 "parsing/parser.mly" +# 1925 "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)) ) -# 5469 "parsing/parser.ml" +# 5472 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5535,37 +5538,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5541 "parsing/parser.ml" +# 5544 "parsing/parser.ml" in let _4 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 5549 "parsing/parser.ml" +# 5552 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 5558 "parsing/parser.ml" +# 5561 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1922 "parsing/parser.mly" +# 1925 "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)) ) -# 5569 "parsing/parser.ml" +# 5572 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5602,9 +5605,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.class_expr) = -# 1782 "parsing/parser.mly" +# 1785 "parsing/parser.mly" ( _2 ) -# 5608 "parsing/parser.ml" +# 5611 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5643,9 +5646,9 @@ module Tables = struct 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" +# 1787 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 5649 "parsing/parser.ml" +# 5652 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5674,42 +5677,42 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5680 "parsing/parser.ml" +# 5683 "parsing/parser.ml" in let tys = let tys = -# 1928 "parsing/parser.mly" +# 1931 "parsing/parser.mly" ( [] ) -# 5687 "parsing/parser.ml" +# 5690 "parsing/parser.ml" in -# 1934 "parsing/parser.mly" +# 1937 "parsing/parser.mly" ( tys ) -# 5692 "parsing/parser.ml" +# 5695 "parsing/parser.ml" in -# 1787 "parsing/parser.mly" +# 1790 "parsing/parser.mly" ( Pcl_constr(cid, tys) ) -# 5698 "parsing/parser.ml" +# 5701 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 866 "parsing/parser.mly" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5707 "parsing/parser.ml" +# 5710 "parsing/parser.ml" in -# 1794 "parsing/parser.mly" +# 1797 "parsing/parser.mly" ( _1 ) -# 5713 "parsing/parser.ml" +# 5716 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5760,9 +5763,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5766 "parsing/parser.ml" +# 5769 "parsing/parser.ml" in let tys = @@ -5771,30 +5774,30 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 5775 "parsing/parser.ml" +# 5778 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 5780 "parsing/parser.ml" +# 5783 "parsing/parser.ml" in -# 1930 "parsing/parser.mly" +# 1933 "parsing/parser.mly" ( params ) -# 5786 "parsing/parser.ml" +# 5789 "parsing/parser.ml" in -# 1934 "parsing/parser.mly" +# 1937 "parsing/parser.mly" ( tys ) -# 5792 "parsing/parser.ml" +# 5795 "parsing/parser.ml" in -# 1787 "parsing/parser.mly" +# 1790 "parsing/parser.mly" ( Pcl_constr(cid, tys) ) -# 5798 "parsing/parser.ml" +# 5801 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -5802,15 +5805,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 866 "parsing/parser.mly" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5808 "parsing/parser.ml" +# 5811 "parsing/parser.ml" in -# 1794 "parsing/parser.mly" +# 1797 "parsing/parser.mly" ( _1 ) -# 5814 "parsing/parser.ml" +# 5817 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5869,43 +5872,43 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 5873 "parsing/parser.ml" +# 5876 "parsing/parser.ml" in -# 1821 "parsing/parser.mly" +# 1824 "parsing/parser.mly" ( _1 ) -# 5878 "parsing/parser.ml" +# 5881 "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" +# 810 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 5887 "parsing/parser.ml" +# 5890 "parsing/parser.ml" in -# 1808 "parsing/parser.mly" +# 1811 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 5893 "parsing/parser.ml" +# 5896 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 5901 "parsing/parser.ml" +# 5904 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1789 "parsing/parser.mly" +# 1792 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 5909 "parsing/parser.ml" +# 5912 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -5913,15 +5916,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 866 "parsing/parser.mly" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5919 "parsing/parser.ml" +# 5922 "parsing/parser.ml" in -# 1794 "parsing/parser.mly" +# 1797 "parsing/parser.mly" ( _1 ) -# 5925 "parsing/parser.ml" +# 5928 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5973,24 +5976,24 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1791 "parsing/parser.mly" +# 1794 "parsing/parser.mly" ( Pcl_constraint(_2, _4) ) -# 5979 "parsing/parser.ml" +# 5982 "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" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5988 "parsing/parser.ml" +# 5991 "parsing/parser.ml" in -# 1794 "parsing/parser.mly" +# 1797 "parsing/parser.mly" ( _1 ) -# 5994 "parsing/parser.ml" +# 5997 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6045,9 +6048,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1793 "parsing/parser.mly" +# 1796 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 6051 "parsing/parser.ml" +# 6054 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -6055,15 +6058,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 866 "parsing/parser.mly" +# 869 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 6061 "parsing/parser.ml" +# 6064 "parsing/parser.ml" in -# 1794 "parsing/parser.mly" +# 1797 "parsing/parser.mly" ( _1 ) -# 6067 "parsing/parser.ml" +# 6070 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6120,44 +6123,44 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 6124 "parsing/parser.ml" +# 6127 "parsing/parser.ml" in -# 1821 "parsing/parser.mly" +# 1824 "parsing/parser.mly" ( _1 ) -# 6129 "parsing/parser.ml" +# 6132 "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" +# 810 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 6138 "parsing/parser.ml" +# 6141 "parsing/parser.ml" in -# 1808 "parsing/parser.mly" +# 1811 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 6144 "parsing/parser.ml" +# 6147 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 6152 "parsing/parser.ml" +# 6155 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1796 "parsing/parser.mly" +# 1799 "parsing/parser.mly" ( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) ) -# 6161 "parsing/parser.ml" +# 6164 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6180,9 +6183,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.class_type) = -# 1899 "parsing/parser.mly" +# 1902 "parsing/parser.mly" ( _1 ) -# 6186 "parsing/parser.ml" +# 6189 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6228,14 +6231,14 @@ module Tables = struct let _v : (Parsetree.class_type) = let _1 = let _1 = let label = -# 3238 "parsing/parser.mly" +# 3241 "parsing/parser.mly" ( Optional label ) -# 6234 "parsing/parser.ml" +# 6237 "parsing/parser.ml" in -# 1905 "parsing/parser.mly" +# 1908 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 6239 "parsing/parser.ml" +# 6242 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -6243,15 +6246,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 860 "parsing/parser.mly" +# 863 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 6249 "parsing/parser.ml" +# 6252 "parsing/parser.ml" in -# 1906 "parsing/parser.mly" +# 1909 "parsing/parser.mly" ( _1 ) -# 6255 "parsing/parser.ml" +# 6258 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6298,9 +6301,9 @@ module Tables = struct let domain : (Parsetree.core_type) = Obj.magic domain in let _2 : unit = Obj.magic _2 in let label : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 6304 "parsing/parser.ml" +# 6307 "parsing/parser.ml" ) = Obj.magic label in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_label_ in @@ -6308,14 +6311,14 @@ module Tables = struct let _v : (Parsetree.class_type) = let _1 = let _1 = let label = -# 3240 "parsing/parser.mly" +# 3243 "parsing/parser.mly" ( Labelled label ) -# 6314 "parsing/parser.ml" +# 6317 "parsing/parser.ml" in -# 1905 "parsing/parser.mly" +# 1908 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 6319 "parsing/parser.ml" +# 6322 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -6323,15 +6326,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 860 "parsing/parser.mly" +# 863 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 6329 "parsing/parser.ml" +# 6332 "parsing/parser.ml" in -# 1906 "parsing/parser.mly" +# 1909 "parsing/parser.mly" ( _1 ) -# 6335 "parsing/parser.ml" +# 6338 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6370,14 +6373,14 @@ module Tables = struct let _v : (Parsetree.class_type) = let _1 = let _1 = let label = -# 3242 "parsing/parser.mly" +# 3245 "parsing/parser.mly" ( Nolabel ) -# 6376 "parsing/parser.ml" +# 6379 "parsing/parser.ml" in -# 1905 "parsing/parser.mly" +# 1908 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 6381 "parsing/parser.ml" +# 6384 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in @@ -6385,15 +6388,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 860 "parsing/parser.mly" +# 863 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 6391 "parsing/parser.ml" +# 6394 "parsing/parser.ml" in -# 1906 "parsing/parser.mly" +# 1909 "parsing/parser.mly" ( _1 ) -# 6397 "parsing/parser.ml" +# 6400 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6476,9 +6479,9 @@ module Tables = struct let csig : (Parsetree.class_type) = Obj.magic csig in let _8 : unit = Obj.magic _8 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 6482 "parsing/parser.ml" +# 6485 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -6494,9 +6497,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 6500 "parsing/parser.ml" +# 6503 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -6506,24 +6509,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 6512 "parsing/parser.ml" +# 6515 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 6520 "parsing/parser.ml" +# 6523 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2044 "parsing/parser.mly" +# 2047 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -6531,19 +6534,19 @@ module Tables = struct ext, Ci.mk id csig ~virt ~params ~attrs ~loc ~docs ) -# 6535 "parsing/parser.ml" +# 6538 "parsing/parser.ml" in -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 6541 "parsing/parser.ml" +# 6544 "parsing/parser.ml" in -# 2032 "parsing/parser.mly" +# 2035 "parsing/parser.mly" ( _1 ) -# 6547 "parsing/parser.ml" +# 6550 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6566,9 +6569,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3527 "parsing/parser.mly" +# 3530 "parsing/parser.mly" ( _1 ) -# 6572 "parsing/parser.ml" +# 6575 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6587,218 +6590,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 633 "parsing/parser.mly" +# 636 "parsing/parser.mly" (string * char option) -# 6593 "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) = -# 3410 "parsing/parser.mly" - ( let (n, m) = _1 in Pconst_integer (n, m) ) -# 6601 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 6622 "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) = -# 3411 "parsing/parser.mly" - ( Pconst_char _1 ) -# 6630 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 6651 "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) = -# 3412 "parsing/parser.mly" - ( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) ) -# 6659 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 6680 "parsing/parser.ml" +# 6596 "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) = # 3413 "parsing/parser.mly" - ( let (f, m) = _1 in Pconst_float (f, m) ) -# 6688 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) = -# 3484 "parsing/parser.mly" - ( "[]" ) -# 6720 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) = -# 3485 "parsing/parser.mly" - ( "()" ) -# 6752 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) = -# 3486 "parsing/parser.mly" - ( "false" ) -# 6777 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) = -# 3487 "parsing/parser.mly" - ( "true" ) -# 6802 "parsing/parser.ml" + ( let (n, m) = _1 in Pconst_integer (n, m) ) +# 6604 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6817,17 +6619,218 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 697 "parsing/parser.mly" - (string) -# 6823 "parsing/parser.ml" +# 595 "parsing/parser.mly" + (char) +# 6625 "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) = +# 3414 "parsing/parser.mly" + ( Pconst_char _1 ) +# 6633 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 : ( +# 688 "parsing/parser.mly" + (string * Location.t * string option) +# 6654 "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) = +# 3415 "parsing/parser.mly" + ( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) ) +# 6662 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 : ( +# 615 "parsing/parser.mly" + (string * char option) +# 6683 "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) = +# 3416 "parsing/parser.mly" + ( let (f, m) = _1 in Pconst_float (f, m) ) +# 6691 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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) = +# 3487 "parsing/parser.mly" + ( "[]" ) +# 6723 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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) = +# 3488 "parsing/parser.mly" + ( "()" ) +# 6755 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = +# 3489 "parsing/parser.mly" + ( "false" ) +# 6780 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = # 3490 "parsing/parser.mly" + ( "true" ) +# 6805 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 : ( +# 700 "parsing/parser.mly" + (string) +# 6826 "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) = +# 3493 "parsing/parser.mly" ( _1 ) -# 6831 "parsing/parser.ml" +# 6834 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6864,14 +6867,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Asttypes.label) = let _1 = -# 3481 "parsing/parser.mly" +# 3484 "parsing/parser.mly" ( "::" ) -# 6870 "parsing/parser.ml" +# 6873 "parsing/parser.ml" in -# 3491 "parsing/parser.mly" +# 3494 "parsing/parser.mly" ( _1 ) -# 6875 "parsing/parser.ml" +# 6878 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6894,9 +6897,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.label) = -# 3492 "parsing/parser.mly" +# 3495 "parsing/parser.mly" ( _1 ) -# 6900 "parsing/parser.ml" +# 6903 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6919,9 +6922,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3495 "parsing/parser.mly" +# 3498 "parsing/parser.mly" ( _1 ) -# 6925 "parsing/parser.ml" +# 6928 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6974,15 +6977,15 @@ module Tables = struct let _v : (Longident.t) = let _3 = let (_2, _1) = (_2_inlined1, _1_inlined1) in -# 3481 "parsing/parser.mly" +# 3484 "parsing/parser.mly" ( "::" ) -# 6980 "parsing/parser.ml" +# 6983 "parsing/parser.ml" in -# 3496 "parsing/parser.mly" +# 3499 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 6986 "parsing/parser.ml" +# 6989 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7019,14 +7022,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = let _1 = -# 3481 "parsing/parser.mly" +# 3484 "parsing/parser.mly" ( "::" ) -# 7025 "parsing/parser.ml" +# 7028 "parsing/parser.ml" in -# 3497 "parsing/parser.mly" +# 3500 "parsing/parser.mly" ( Lident _1 ) -# 7030 "parsing/parser.ml" +# 7033 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7049,9 +7052,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3498 "parsing/parser.mly" +# 3501 "parsing/parser.mly" ( Lident _1 ) -# 7055 "parsing/parser.ml" +# 7058 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7088,9 +7091,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.core_type * Parsetree.core_type) = -# 1988 "parsing/parser.mly" +# 1991 "parsing/parser.mly" ( _1, _3 ) -# 7094 "parsing/parser.ml" +# 7097 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7115,26 +7118,26 @@ module Tables = struct let _v : (Parsetree.constructor_arguments) = let tys = let xs = let xs = -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 7121 "parsing/parser.ml" +# 7124 "parsing/parser.ml" in # 253 "" ( List.rev xs ) -# 7126 "parsing/parser.ml" +# 7129 "parsing/parser.ml" in -# 951 "parsing/parser.mly" +# 954 "parsing/parser.mly" ( xs ) -# 7132 "parsing/parser.ml" +# 7135 "parsing/parser.ml" in -# 3045 "parsing/parser.mly" +# 3048 "parsing/parser.mly" ( Pcstr_tuple tys ) -# 7138 "parsing/parser.ml" +# 7141 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7173,26 +7176,26 @@ module Tables = struct let _v : (Parsetree.constructor_arguments) = let tys = let xs = let xs = -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 7179 "parsing/parser.ml" +# 7182 "parsing/parser.ml" in # 253 "" ( List.rev xs ) -# 7184 "parsing/parser.ml" +# 7187 "parsing/parser.ml" in -# 951 "parsing/parser.mly" +# 954 "parsing/parser.mly" ( xs ) -# 7190 "parsing/parser.ml" +# 7193 "parsing/parser.ml" in -# 3045 "parsing/parser.mly" +# 3048 "parsing/parser.mly" ( Pcstr_tuple tys ) -# 7196 "parsing/parser.ml" +# 7199 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7229,9 +7232,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.constructor_arguments) = -# 3047 "parsing/parser.mly" +# 3050 "parsing/parser.mly" ( Pcstr_record _2 ) -# 7235 "parsing/parser.ml" +# 7238 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7254,9 +7257,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constructor_declaration list) = -# 2966 "parsing/parser.mly" +# 2969 "parsing/parser.mly" ( [] ) -# 7260 "parsing/parser.ml" +# 7263 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7279,14 +7282,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_xs_ in let _v : (Parsetree.constructor_declaration list) = let cs = -# 1036 "parsing/parser.mly" +# 1039 "parsing/parser.mly" ( List.rev xs ) -# 7285 "parsing/parser.ml" +# 7288 "parsing/parser.ml" in -# 2968 "parsing/parser.mly" +# 2971 "parsing/parser.mly" ( cs ) -# 7290 "parsing/parser.ml" +# 7293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7309,14 +7312,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 7315 "parsing/parser.ml" +# 7318 "parsing/parser.ml" in -# 3190 "parsing/parser.mly" +# 3193 "parsing/parser.mly" ( _1 ) -# 7320 "parsing/parser.ml" +# 7323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7346,9 +7349,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = -# 3192 "parsing/parser.mly" +# 3195 "parsing/parser.mly" ( Typ.attr _1 _2 ) -# 7352 "parsing/parser.ml" +# 7355 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7371,9 +7374,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.direction_flag) = -# 3589 "parsing/parser.mly" +# 3592 "parsing/parser.mly" ( Upto ) -# 7377 "parsing/parser.ml" +# 7380 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7396,9 +7399,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.direction_flag) = -# 3590 "parsing/parser.mly" +# 3593 "parsing/parser.mly" ( Downto ) -# 7402 "parsing/parser.ml" +# 7405 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7421,9 +7424,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = -# 2135 "parsing/parser.mly" +# 2138 "parsing/parser.mly" ( _1 ) -# 7427 "parsing/parser.ml" +# 7430 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7501,9 +7504,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7507 "parsing/parser.ml" +# 7510 "parsing/parser.ml" in let _3 = @@ -7511,21 +7514,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 7517 "parsing/parser.ml" +# 7520 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 7523 "parsing/parser.ml" +# 7526 "parsing/parser.ml" in -# 2183 "parsing/parser.mly" +# 2186 "parsing/parser.mly" ( Pexp_letmodule(_4, _5, _7), _3 ) -# 7529 "parsing/parser.ml" +# 7532 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -7533,10 +7536,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7540 "parsing/parser.ml" +# 7543 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7620,9 +7623,9 @@ module Tables = struct let _3 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 7626 "parsing/parser.ml" +# 7629 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -7631,19 +7634,19 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7637 "parsing/parser.ml" +# 7640 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3030 "parsing/parser.mly" +# 3033 "parsing/parser.mly" ( let args, res = _2 in Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) ) -# 7647 "parsing/parser.ml" +# 7650 "parsing/parser.ml" in let _3 = @@ -7651,21 +7654,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 7657 "parsing/parser.ml" +# 7660 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 7663 "parsing/parser.ml" +# 7666 "parsing/parser.ml" in -# 2185 "parsing/parser.mly" +# 2188 "parsing/parser.mly" ( Pexp_letexception(_4, _6), _3 ) -# 7669 "parsing/parser.ml" +# 7672 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -7673,10 +7676,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7680 "parsing/parser.ml" +# 7683 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7746,28 +7749,28 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 7752 "parsing/parser.ml" +# 7755 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 7758 "parsing/parser.ml" +# 7761 "parsing/parser.ml" in let _3 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 7764 "parsing/parser.ml" +# 7767 "parsing/parser.ml" in -# 2187 "parsing/parser.mly" +# 2190 "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 ) -# 7771 "parsing/parser.ml" +# 7774 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -7775,10 +7778,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7782 "parsing/parser.ml" +# 7785 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7855,31 +7858,31 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 7861 "parsing/parser.ml" +# 7864 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 7867 "parsing/parser.ml" +# 7870 "parsing/parser.ml" in let _3 = let _1 = _1_inlined1 in -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 7875 "parsing/parser.ml" +# 7878 "parsing/parser.ml" in -# 2187 "parsing/parser.mly" +# 2190 "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 ) -# 7883 "parsing/parser.ml" +# 7886 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -7887,10 +7890,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7894 "parsing/parser.ml" +# 7897 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7939,18 +7942,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 7943 "parsing/parser.ml" +# 7946 "parsing/parser.ml" in -# 1008 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( xs ) -# 7948 "parsing/parser.ml" +# 7951 "parsing/parser.ml" in -# 2519 "parsing/parser.mly" +# 2522 "parsing/parser.mly" ( xs ) -# 7954 "parsing/parser.ml" +# 7957 "parsing/parser.ml" in let _2 = @@ -7958,21 +7961,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 7964 "parsing/parser.ml" +# 7967 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 7970 "parsing/parser.ml" +# 7973 "parsing/parser.ml" in -# 2191 "parsing/parser.mly" +# 2194 "parsing/parser.mly" ( Pexp_function _3, _2 ) -# 7976 "parsing/parser.ml" +# 7979 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -7980,10 +7983,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7987 "parsing/parser.ml" +# 7990 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8039,22 +8042,22 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8045 "parsing/parser.ml" +# 8048 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8051 "parsing/parser.ml" +# 8054 "parsing/parser.ml" in -# 2193 "parsing/parser.mly" +# 2196 "parsing/parser.mly" ( let (l,o,p) = _3 in Pexp_fun(l, o, p, _4), _2 ) -# 8058 "parsing/parser.ml" +# 8061 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -8062,10 +8065,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8069 "parsing/parser.ml" +# 8072 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8138,33 +8141,33 @@ module Tables = struct let _endpos = _endpos__7_ in let _v : (Parsetree.expression) = let _1 = let _5 = -# 2414 "parsing/parser.mly" +# 2417 "parsing/parser.mly" ( xs ) -# 8144 "parsing/parser.ml" +# 8147 "parsing/parser.ml" in let _2 = let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8153 "parsing/parser.ml" +# 8156 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8159 "parsing/parser.ml" +# 8162 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2196 "parsing/parser.mly" +# 2199 "parsing/parser.mly" ( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 ) -# 8168 "parsing/parser.ml" +# 8171 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8172,10 +8175,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8179 "parsing/parser.ml" +# 8182 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8238,18 +8241,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 8242 "parsing/parser.ml" +# 8245 "parsing/parser.ml" in -# 1008 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( xs ) -# 8247 "parsing/parser.ml" +# 8250 "parsing/parser.ml" in -# 2519 "parsing/parser.mly" +# 2522 "parsing/parser.mly" ( xs ) -# 8253 "parsing/parser.ml" +# 8256 "parsing/parser.ml" in let _2 = @@ -8257,21 +8260,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8263 "parsing/parser.ml" +# 8266 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8269 "parsing/parser.ml" +# 8272 "parsing/parser.ml" in -# 2198 "parsing/parser.mly" +# 2201 "parsing/parser.mly" ( Pexp_match(_3, _5), _2 ) -# 8275 "parsing/parser.ml" +# 8278 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8279,10 +8282,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8286 "parsing/parser.ml" +# 8289 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8345,18 +8348,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 8349 "parsing/parser.ml" +# 8352 "parsing/parser.ml" in -# 1008 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( xs ) -# 8354 "parsing/parser.ml" +# 8357 "parsing/parser.ml" in -# 2519 "parsing/parser.mly" +# 2522 "parsing/parser.mly" ( xs ) -# 8360 "parsing/parser.ml" +# 8363 "parsing/parser.ml" in let _2 = @@ -8364,21 +8367,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8370 "parsing/parser.ml" +# 8373 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8376 "parsing/parser.ml" +# 8379 "parsing/parser.ml" in -# 2200 "parsing/parser.mly" +# 2203 "parsing/parser.mly" ( Pexp_try(_3, _5), _2 ) -# 8382 "parsing/parser.ml" +# 8385 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8386,10 +8389,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8393 "parsing/parser.ml" +# 8396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8452,21 +8455,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8458 "parsing/parser.ml" +# 8461 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8464 "parsing/parser.ml" +# 8467 "parsing/parser.ml" in -# 2202 "parsing/parser.mly" +# 2205 "parsing/parser.mly" ( syntax_error() ) -# 8470 "parsing/parser.ml" +# 8473 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -8474,10 +8477,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8481 "parsing/parser.ml" +# 8484 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8554,21 +8557,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8560 "parsing/parser.ml" +# 8563 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8566 "parsing/parser.ml" +# 8569 "parsing/parser.ml" in -# 2204 "parsing/parser.mly" +# 2207 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, Some _7), _2 ) -# 8572 "parsing/parser.ml" +# 8575 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8576,10 +8579,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8583 "parsing/parser.ml" +# 8586 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8642,21 +8645,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8648 "parsing/parser.ml" +# 8651 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8654 "parsing/parser.ml" +# 8657 "parsing/parser.ml" in -# 2206 "parsing/parser.mly" +# 2209 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, None), _2 ) -# 8660 "parsing/parser.ml" +# 8663 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -8664,10 +8667,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8671 "parsing/parser.ml" +# 8674 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8737,21 +8740,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8743 "parsing/parser.ml" +# 8746 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8749 "parsing/parser.ml" +# 8752 "parsing/parser.ml" in -# 2208 "parsing/parser.mly" +# 2211 "parsing/parser.mly" ( Pexp_while(_3, _5), _2 ) -# 8755 "parsing/parser.ml" +# 8758 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -8759,10 +8762,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8766 "parsing/parser.ml" +# 8769 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8860,21 +8863,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8866 "parsing/parser.ml" +# 8869 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8872 "parsing/parser.ml" +# 8875 "parsing/parser.ml" in -# 2211 "parsing/parser.mly" +# 2214 "parsing/parser.mly" ( Pexp_for(_3, _5, _7, _6, _9), _2 ) -# 8878 "parsing/parser.ml" +# 8881 "parsing/parser.ml" in let _endpos__1_ = _endpos__10_ in @@ -8882,10 +8885,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8889 "parsing/parser.ml" +# 8892 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8934,21 +8937,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 8940 "parsing/parser.ml" +# 8943 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 8946 "parsing/parser.ml" +# 8949 "parsing/parser.ml" in -# 2213 "parsing/parser.mly" +# 2216 "parsing/parser.mly" ( Pexp_assert _3, _2 ) -# 8952 "parsing/parser.ml" +# 8955 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -8956,10 +8959,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8963 "parsing/parser.ml" +# 8966 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9008,21 +9011,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 9014 "parsing/parser.ml" +# 9017 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 9020 "parsing/parser.ml" +# 9023 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2218 "parsing/parser.mly" ( Pexp_lazy _3, _2 ) -# 9026 "parsing/parser.ml" +# 9029 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -9030,10 +9033,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9037 "parsing/parser.ml" +# 9040 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9098,27 +9101,27 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 9102 "parsing/parser.ml" +# 9105 "parsing/parser.ml" in -# 1821 "parsing/parser.mly" +# 1824 "parsing/parser.mly" ( _1 ) -# 9107 "parsing/parser.ml" +# 9110 "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" +# 810 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 9116 "parsing/parser.ml" +# 9119 "parsing/parser.ml" in -# 1808 "parsing/parser.mly" +# 1811 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 9122 "parsing/parser.ml" +# 9125 "parsing/parser.ml" in let _2 = @@ -9126,21 +9129,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 9132 "parsing/parser.ml" +# 9135 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 9138 "parsing/parser.ml" +# 9141 "parsing/parser.ml" in -# 2217 "parsing/parser.mly" +# 2220 "parsing/parser.mly" ( Pexp_object _3, _2 ) -# 9144 "parsing/parser.ml" +# 9147 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -9148,10 +9151,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9155 "parsing/parser.ml" +# 9158 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9216,27 +9219,27 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 9220 "parsing/parser.ml" +# 9223 "parsing/parser.ml" in -# 1821 "parsing/parser.mly" +# 1824 "parsing/parser.mly" ( _1 ) -# 9225 "parsing/parser.ml" +# 9228 "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" +# 810 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 9234 "parsing/parser.ml" +# 9237 "parsing/parser.ml" in -# 1808 "parsing/parser.mly" +# 1811 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 9240 "parsing/parser.ml" +# 9243 "parsing/parser.ml" in let _2 = @@ -9244,23 +9247,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 9250 "parsing/parser.ml" +# 9253 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 9256 "parsing/parser.ml" +# 9259 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2219 "parsing/parser.mly" +# 2222 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 9264 "parsing/parser.ml" +# 9267 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -9268,10 +9271,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2137 "parsing/parser.mly" +# 2140 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9275 "parsing/parser.ml" +# 9278 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9306,18 +9309,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9310 "parsing/parser.ml" +# 9313 "parsing/parser.ml" in -# 915 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 9315 "parsing/parser.ml" +# 9318 "parsing/parser.ml" in -# 2223 "parsing/parser.mly" +# 2226 "parsing/parser.mly" ( Pexp_apply(_1, _2) ) -# 9321 "parsing/parser.ml" +# 9324 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -9325,15 +9328,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9331 "parsing/parser.ml" +# 9334 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9337 "parsing/parser.ml" +# 9340 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9362,24 +9365,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 9366 "parsing/parser.ml" +# 9369 "parsing/parser.ml" in -# 975 "parsing/parser.mly" +# 978 "parsing/parser.mly" ( xs ) -# 9371 "parsing/parser.ml" +# 9374 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2549 "parsing/parser.mly" ( es ) -# 9377 "parsing/parser.ml" +# 9380 "parsing/parser.ml" in -# 2225 "parsing/parser.mly" +# 2228 "parsing/parser.mly" ( Pexp_tuple(_1) ) -# 9383 "parsing/parser.ml" +# 9386 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in @@ -9387,15 +9390,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9393 "parsing/parser.ml" +# 9396 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9399 "parsing/parser.ml" +# 9402 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9431,15 +9434,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 9437 "parsing/parser.ml" +# 9440 "parsing/parser.ml" in -# 2227 "parsing/parser.mly" +# 2230 "parsing/parser.mly" ( Pexp_construct(_1, Some _2) ) -# 9443 "parsing/parser.ml" +# 9446 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -9447,15 +9450,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9453 "parsing/parser.ml" +# 9456 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9459 "parsing/parser.ml" +# 9462 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9486,255 +9489,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2229 "parsing/parser.mly" +# 2232 "parsing/parser.mly" ( Pexp_variant(_1, Some _2) ) -# 9492 "parsing/parser.ml" +# 9495 "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" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9501 "parsing/parser.ml" +# 9504 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9507 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 9541 "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 = -# 3454 "parsing/parser.mly" - ( op ) -# 9553 "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 ) -# 9562 "parsing/parser.ml" - - in - -# 2231 "parsing/parser.mly" - ( mkinfix e1 op e2 ) -# 9568 "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 ) -# 9578 "parsing/parser.ml" - - in - -# 2140 "parsing/parser.mly" - ( _1 ) -# 9584 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 9618 "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 = -# 3455 "parsing/parser.mly" - ( op ) -# 9630 "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 ) -# 9639 "parsing/parser.ml" - - in - -# 2231 "parsing/parser.mly" - ( mkinfix e1 op e2 ) -# 9645 "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 ) -# 9655 "parsing/parser.ml" - - in - -# 2140 "parsing/parser.mly" - ( _1 ) -# 9661 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 9695 "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 = -# 3456 "parsing/parser.mly" - ( op ) -# 9707 "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 ) -# 9716 "parsing/parser.ml" - - in - -# 2231 "parsing/parser.mly" - ( mkinfix e1 op e2 ) -# 9722 "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 ) -# 9732 "parsing/parser.ml" - - in - -# 2140 "parsing/parser.mly" - ( _1 ) -# 9738 "parsing/parser.ml" +# 9510 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9768,7 +9540,7 @@ module Tables = struct let op : ( # 626 "parsing/parser.mly" (string) -# 9772 "parsing/parser.ml" +# 9544 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9780,22 +9552,22 @@ module Tables = struct let _1 = # 3457 "parsing/parser.mly" ( op ) -# 9784 "parsing/parser.ml" +# 9556 "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" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9793 "parsing/parser.ml" +# 9565 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9799 "parsing/parser.ml" +# 9571 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9803,15 +9575,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9809 "parsing/parser.ml" +# 9581 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9815 "parsing/parser.ml" +# 9587 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9845,7 +9617,7 @@ module Tables = struct let op : ( # 627 "parsing/parser.mly" (string) -# 9849 "parsing/parser.ml" +# 9621 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9857,22 +9629,22 @@ module Tables = struct let _1 = # 3458 "parsing/parser.mly" ( op ) -# 9861 "parsing/parser.ml" +# 9633 "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" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9870 "parsing/parser.ml" +# 9642 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9876 "parsing/parser.ml" +# 9648 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9880,15 +9652,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9886 "parsing/parser.ml" +# 9658 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9892 "parsing/parser.ml" +# 9664 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9906,9 +9678,9 @@ module Tables = struct 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.semv = op; + MenhirLib.EngineTypes.startp = _startpos_op_; + MenhirLib.EngineTypes.endp = _endpos_op_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _menhir_s; MenhirLib.EngineTypes.semv = e1; @@ -9919,7 +9691,11 @@ module Tables = struct }; } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in - let _1 : unit = Obj.magic _1 in + let op : ( +# 628 "parsing/parser.mly" + (string) +# 9698 "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 @@ -9929,22 +9705,23 @@ module Tables = struct let op = let _1 = # 3459 "parsing/parser.mly" - ("+") -# 9934 "parsing/parser.ml" + ( op ) +# 9710 "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" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9942 "parsing/parser.ml" +# 9719 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9948 "parsing/parser.ml" +# 9725 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9952,15 +9729,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9958 "parsing/parser.ml" +# 9735 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 9964 "parsing/parser.ml" +# 9741 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9978,9 +9755,9 @@ module Tables = struct 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.semv = op; + MenhirLib.EngineTypes.startp = _startpos_op_; + MenhirLib.EngineTypes.endp = _endpos_op_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _menhir_s; MenhirLib.EngineTypes.semv = e1; @@ -9991,7 +9768,11 @@ module Tables = struct }; } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in - let _1 : unit = Obj.magic _1 in + let op : ( +# 629 "parsing/parser.mly" + (string) +# 9775 "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 @@ -10001,22 +9782,23 @@ module Tables = struct let op = let _1 = # 3460 "parsing/parser.mly" - ("+.") -# 10006 "parsing/parser.ml" + ( op ) +# 9787 "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" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10014 "parsing/parser.ml" +# 9796 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10020 "parsing/parser.ml" +# 9802 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10024,15 +9806,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10030 "parsing/parser.ml" +# 9812 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10036 "parsing/parser.ml" +# 9818 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10050,9 +9832,9 @@ module Tables = struct 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.semv = op; + MenhirLib.EngineTypes.startp = _startpos_op_; + MenhirLib.EngineTypes.endp = _endpos_op_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _menhir_s; MenhirLib.EngineTypes.semv = e1; @@ -10063,7 +9845,11 @@ module Tables = struct }; } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in - let _1 : unit = Obj.magic _1 in + let op : ( +# 630 "parsing/parser.mly" + (string) +# 9852 "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 @@ -10073,22 +9859,23 @@ module Tables = struct let op = let _1 = # 3461 "parsing/parser.mly" - ("+=") -# 10078 "parsing/parser.ml" + ( op ) +# 9864 "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" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10086 "parsing/parser.ml" +# 9873 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10092 "parsing/parser.ml" +# 9879 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10096,15 +9883,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10102 "parsing/parser.ml" +# 9889 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10108 "parsing/parser.ml" +# 9895 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10145,22 +9932,22 @@ module Tables = struct let op = let _1 = # 3462 "parsing/parser.mly" - ("-") -# 10150 "parsing/parser.ml" + ("+") +# 9937 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10158 "parsing/parser.ml" +# 9945 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10164 "parsing/parser.ml" +# 9951 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10168,15 +9955,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10174 "parsing/parser.ml" +# 9961 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10180 "parsing/parser.ml" +# 9967 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10217,22 +10004,22 @@ module Tables = struct let op = let _1 = # 3463 "parsing/parser.mly" - ("-.") -# 10222 "parsing/parser.ml" + ("+.") +# 10009 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10230 "parsing/parser.ml" +# 10017 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10236 "parsing/parser.ml" +# 10023 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10240,15 +10027,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10246 "parsing/parser.ml" +# 10033 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10252 "parsing/parser.ml" +# 10039 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10289,22 +10076,22 @@ module Tables = struct let op = let _1 = # 3464 "parsing/parser.mly" - ("*") -# 10294 "parsing/parser.ml" + ("+=") +# 10081 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10302 "parsing/parser.ml" +# 10089 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10308 "parsing/parser.ml" +# 10095 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10312,15 +10099,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10318 "parsing/parser.ml" +# 10105 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10324 "parsing/parser.ml" +# 10111 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10361,22 +10148,22 @@ module Tables = struct let op = let _1 = # 3465 "parsing/parser.mly" - ("%") -# 10366 "parsing/parser.ml" + ("-") +# 10153 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10374 "parsing/parser.ml" +# 10161 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10380 "parsing/parser.ml" +# 10167 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10384,15 +10171,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10390 "parsing/parser.ml" +# 10177 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10396 "parsing/parser.ml" +# 10183 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10433,22 +10220,22 @@ module Tables = struct let op = let _1 = # 3466 "parsing/parser.mly" - ("=") -# 10438 "parsing/parser.ml" + ("-.") +# 10225 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10446 "parsing/parser.ml" +# 10233 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10452 "parsing/parser.ml" +# 10239 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10456,15 +10243,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10462 "parsing/parser.ml" +# 10249 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10468 "parsing/parser.ml" +# 10255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10505,22 +10292,22 @@ module Tables = struct let op = let _1 = # 3467 "parsing/parser.mly" - ("<") -# 10510 "parsing/parser.ml" + ("*") +# 10297 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10518 "parsing/parser.ml" +# 10305 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10524 "parsing/parser.ml" +# 10311 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10528,15 +10315,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10534 "parsing/parser.ml" +# 10321 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10540 "parsing/parser.ml" +# 10327 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10577,22 +10364,22 @@ module Tables = struct let op = let _1 = # 3468 "parsing/parser.mly" - (">") -# 10582 "parsing/parser.ml" + ("%") +# 10369 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10590 "parsing/parser.ml" +# 10377 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10596 "parsing/parser.ml" +# 10383 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10600,15 +10387,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10606 "parsing/parser.ml" +# 10393 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10612 "parsing/parser.ml" +# 10399 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10649,22 +10436,22 @@ module Tables = struct let op = let _1 = # 3469 "parsing/parser.mly" - ("or") -# 10654 "parsing/parser.ml" + ("=") +# 10441 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10662 "parsing/parser.ml" +# 10449 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10668 "parsing/parser.ml" +# 10455 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10672,15 +10459,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10678 "parsing/parser.ml" +# 10465 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10684 "parsing/parser.ml" +# 10471 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10721,22 +10508,22 @@ module Tables = struct let op = let _1 = # 3470 "parsing/parser.mly" - ("||") -# 10726 "parsing/parser.ml" + ("<") +# 10513 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10734 "parsing/parser.ml" +# 10521 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10740 "parsing/parser.ml" +# 10527 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10744,15 +10531,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10750 "parsing/parser.ml" +# 10537 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10756 "parsing/parser.ml" +# 10543 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10793,22 +10580,22 @@ module Tables = struct let op = let _1 = # 3471 "parsing/parser.mly" - ("&") -# 10798 "parsing/parser.ml" + (">") +# 10585 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10806 "parsing/parser.ml" +# 10593 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10812 "parsing/parser.ml" +# 10599 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10816,15 +10603,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10822 "parsing/parser.ml" +# 10609 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10828 "parsing/parser.ml" +# 10615 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10865,22 +10652,22 @@ module Tables = struct let op = let _1 = # 3472 "parsing/parser.mly" - ("&&") -# 10870 "parsing/parser.ml" + ("or") +# 10657 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10878 "parsing/parser.ml" +# 10665 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10884 "parsing/parser.ml" +# 10671 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10888,15 +10675,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10894 "parsing/parser.ml" +# 10681 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10900 "parsing/parser.ml" +# 10687 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10937,22 +10724,22 @@ module Tables = struct let op = let _1 = # 3473 "parsing/parser.mly" - (":=") -# 10942 "parsing/parser.ml" + ("||") +# 10729 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10950 "parsing/parser.ml" +# 10737 "parsing/parser.ml" in -# 2231 "parsing/parser.mly" +# 2234 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10956 "parsing/parser.ml" +# 10743 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10960,15 +10747,231 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10966 "parsing/parser.ml" +# 10753 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 10972 "parsing/parser.ml" +# 10759 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 3474 "parsing/parser.mly" + ("&") +# 10801 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 843 "parsing/parser.mly" + ( mkoperator ~loc:_sloc _1 ) +# 10809 "parsing/parser.ml" + + in + +# 2234 "parsing/parser.mly" + ( mkinfix e1 op e2 ) +# 10815 "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 + +# 849 "parsing/parser.mly" + ( mkexp ~loc:_sloc _1 ) +# 10825 "parsing/parser.ml" + + in + +# 2143 "parsing/parser.mly" + ( _1 ) +# 10831 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 3475 "parsing/parser.mly" + ("&&") +# 10873 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 843 "parsing/parser.mly" + ( mkoperator ~loc:_sloc _1 ) +# 10881 "parsing/parser.ml" + + in + +# 2234 "parsing/parser.mly" + ( mkinfix e1 op e2 ) +# 10887 "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 + +# 849 "parsing/parser.mly" + ( mkexp ~loc:_sloc _1 ) +# 10897 "parsing/parser.ml" + + in + +# 2143 "parsing/parser.mly" + ( _1 ) +# 10903 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 3476 "parsing/parser.mly" + (":=") +# 10945 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 843 "parsing/parser.mly" + ( mkoperator ~loc:_sloc _1 ) +# 10953 "parsing/parser.ml" + + in + +# 2234 "parsing/parser.mly" + ( mkinfix e1 op e2 ) +# 10959 "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 + +# 849 "parsing/parser.mly" + ( mkexp ~loc:_sloc _1 ) +# 10969 "parsing/parser.ml" + + in + +# 2143 "parsing/parser.mly" + ( _1 ) +# 10975 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11001,9 +11004,9 @@ module Tables = struct let _1 = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2233 "parsing/parser.mly" +# 2236 "parsing/parser.mly" ( mkuminus ~oploc:_loc__1_ _1 _2 ) -# 11007 "parsing/parser.ml" +# 11010 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -11011,15 +11014,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11017 "parsing/parser.ml" +# 11020 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 11023 "parsing/parser.ml" +# 11026 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11052,9 +11055,9 @@ module Tables = struct let _1 = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2235 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( mkuplus ~oploc:_loc__1_ _1 _2 ) -# 11058 "parsing/parser.ml" +# 11061 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -11062,15 +11065,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11068 "parsing/parser.ml" +# 11071 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( _1 ) -# 11074 "parsing/parser.ml" +# 11077 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11110,9 +11113,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2142 "parsing/parser.mly" +# 2145 "parsing/parser.mly" ( expr_of_let_bindings ~loc:_sloc _1 _3 ) -# 11116 "parsing/parser.ml" +# 11119 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11152,9 +11155,9 @@ module Tables = struct let _3 : unit = Obj.magic _3 in let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in let _1 : ( -# 629 "parsing/parser.mly" +# 632 "parsing/parser.mly" (string) -# 11158 "parsing/parser.ml" +# 11161 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -11164,9 +11167,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 11170 "parsing/parser.ml" +# 11173 "parsing/parser.ml" in let _startpos_pbop_op_ = _startpos__1_ in @@ -11174,13 +11177,13 @@ module Tables = struct let _symbolstartpos = _startpos_pbop_op_ in let _sloc = (_symbolstartpos, _endpos) in -# 2144 "parsing/parser.mly" +# 2147 "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}) ) -# 11184 "parsing/parser.ml" +# 11187 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11221,9 +11224,9 @@ module Tables = struct let _loc__2_ = (_startpos__2_, _endpos__2_) in let _sloc = (_symbolstartpos, _endpos) in -# 2150 "parsing/parser.mly" +# 2153 "parsing/parser.mly" ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) ) -# 11227 "parsing/parser.ml" +# 11230 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11256,35 +11259,35 @@ module Tables = struct let _3 : (Parsetree.expression) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 11262 "parsing/parser.ml" +# 11265 "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 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 11271 "parsing/parser.ml" +# 11274 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 11279 "parsing/parser.ml" +# 11282 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2152 "parsing/parser.mly" +# 2155 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) ) -# 11288 "parsing/parser.ml" +# 11291 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11340,18 +11343,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 11346 "parsing/parser.ml" +# 11349 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2154 "parsing/parser.mly" +# 2157 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) ) -# 11355 "parsing/parser.ml" +# 11358 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11419,9 +11422,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2156 "parsing/parser.mly" +# 2159 "parsing/parser.mly" ( array_set ~loc:_sloc _1 _4 _7 ) -# 11425 "parsing/parser.ml" +# 11428 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11489,9 +11492,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2158 "parsing/parser.mly" +# 2161 "parsing/parser.mly" ( string_set ~loc:_sloc _1 _4 _7 ) -# 11495 "parsing/parser.ml" +# 11498 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11559,9 +11562,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2160 "parsing/parser.mly" +# 2163 "parsing/parser.mly" ( bigarray_set ~loc:_sloc _1 _4 _7 ) -# 11565 "parsing/parser.ml" +# 11568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11621,26 +11624,26 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 11627 "parsing/parser.ml" +# 11630 "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" +# 2589 "parsing/parser.mly" ( es ) -# 11636 "parsing/parser.ml" +# 11639 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2162 "parsing/parser.mly" +# 2165 "parsing/parser.mly" ( dotop_set ~loc:_sloc lident bracket _2 _1 _4 _7 ) -# 11644 "parsing/parser.ml" +# 11647 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11700,26 +11703,26 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 11706 "parsing/parser.ml" +# 11709 "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" +# 2589 "parsing/parser.mly" ( es ) -# 11715 "parsing/parser.ml" +# 11718 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2164 "parsing/parser.mly" +# 2167 "parsing/parser.mly" ( dotop_set ~loc:_sloc lident paren _2 _1 _4 _7 ) -# 11723 "parsing/parser.ml" +# 11726 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11779,119 +11782,26 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 11785 "parsing/parser.ml" +# 11788 "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" +# 2589 "parsing/parser.mly" ( es ) -# 11794 "parsing/parser.ml" +# 11797 "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 ) -# 11802 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 11876 "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 ) -# 11887 "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 ) -# 11895 "parsing/parser.ml" + ( dotop_set ~loc:_sloc lident brace _2 _1 _4 _7 ) +# 11805 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11963,9 +11873,9 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 11969 "parsing/parser.ml" +# 11879 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -11974,17 +11884,17 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__9_ in let _v : (Parsetree.expression) = let _6 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 11980 "parsing/parser.ml" +# 11890 "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 ) -# 11988 "parsing/parser.ml" + ( dotop_set ~loc:_sloc (ldot _3) bracket _4 _1 _6 _9 ) +# 11898 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12056,9 +11966,9 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 12062 "parsing/parser.ml" +# 11972 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -12067,17 +11977,110 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__9_ in let _v : (Parsetree.expression) = let _6 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 12073 "parsing/parser.ml" +# 11983 "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) paren _4 _1 _6 _9 ) +# 11991 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 12065 "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 = +# 2589 "parsing/parser.mly" + ( es ) +# 12076 "parsing/parser.ml" + in + let _endpos = _endpos__9_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 2178 "parsing/parser.mly" ( dotop_set ~loc:_sloc (ldot _3) brace _4 _1 _6 _9 ) -# 12081 "parsing/parser.ml" +# 12084 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12107,9 +12110,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2177 "parsing/parser.mly" +# 2180 "parsing/parser.mly" ( Exp.attr _1 _2 ) -# 12113 "parsing/parser.ml" +# 12116 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12133,9 +12136,9 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2179 "parsing/parser.mly" +# 2182 "parsing/parser.mly" ( not_expecting _loc__1_ "wildcard \"_\"" ) -# 12139 "parsing/parser.ml" +# 12142 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12151,9 +12154,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (string Asttypes.loc option) = -# 3745 "parsing/parser.mly" +# 3748 "parsing/parser.mly" ( None ) -# 12157 "parsing/parser.ml" +# 12160 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12183,9 +12186,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (string Asttypes.loc option) = -# 3746 "parsing/parser.mly" +# 3749 "parsing/parser.mly" ( Some _2 ) -# 12189 "parsing/parser.ml" +# 12192 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12229,9 +12232,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.extension) = -# 3756 "parsing/parser.mly" +# 3759 "parsing/parser.mly" ( (_2, _3) ) -# 12235 "parsing/parser.ml" +# 12238 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12250,9 +12253,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 687 "parsing/parser.mly" +# 690 "parsing/parser.mly" (string * Location.t * string * Location.t * string option) -# 12256 "parsing/parser.ml" +# 12259 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -12261,9 +12264,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3758 "parsing/parser.mly" +# 3761 "parsing/parser.mly" ( mk_quotedext ~loc:_sloc _1 ) -# 12267 "parsing/parser.ml" +# 12270 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12316,9 +12319,9 @@ module Tables = struct let _v : (Parsetree.extension_constructor) = let attrs = let _1 = _1_inlined3 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 12322 "parsing/parser.ml" +# 12325 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined3_ in @@ -12328,9 +12331,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12334 "parsing/parser.ml" +# 12337 "parsing/parser.ml" in let cid = @@ -12339,19 +12342,19 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12345 "parsing/parser.ml" +# 12348 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3114 "parsing/parser.mly" +# 3117 "parsing/parser.mly" ( let info = symbol_info _endpos in Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info ) -# 12355 "parsing/parser.ml" +# 12358 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12397,9 +12400,9 @@ module Tables = struct let _v : (Parsetree.extension_constructor) = let attrs = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 12403 "parsing/parser.ml" +# 12406 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined2_ in @@ -12409,9 +12412,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12415 "parsing/parser.ml" +# 12418 "parsing/parser.ml" in let cid = @@ -12419,25 +12422,25 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12425 "parsing/parser.ml" +# 12428 "parsing/parser.ml" in let _startpos_cid_ = _startpos__1_ in let _1 = -# 3565 "parsing/parser.mly" +# 3568 "parsing/parser.mly" ( () ) -# 12432 "parsing/parser.ml" +# 12435 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos_cid_ in let _sloc = (_symbolstartpos, _endpos) in -# 3114 "parsing/parser.mly" +# 3117 "parsing/parser.mly" ( let info = symbol_info _endpos in Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info ) -# 12441 "parsing/parser.ml" +# 12444 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12484,10 +12487,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3733 "parsing/parser.mly" +# 3736 "parsing/parser.mly" ( mark_symbol_docs _sloc; Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 12491 "parsing/parser.ml" +# 12494 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12503,14 +12506,14 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params = -# 1928 "parsing/parser.mly" +# 1931 "parsing/parser.mly" ( [] ) -# 12509 "parsing/parser.ml" +# 12512 "parsing/parser.ml" in -# 1753 "parsing/parser.mly" +# 1756 "parsing/parser.mly" ( params ) -# 12514 "parsing/parser.ml" +# 12517 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12551,24 +12554,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 12555 "parsing/parser.ml" +# 12558 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 12560 "parsing/parser.ml" +# 12563 "parsing/parser.ml" in -# 1930 "parsing/parser.mly" +# 1933 "parsing/parser.mly" ( params ) -# 12566 "parsing/parser.ml" +# 12569 "parsing/parser.ml" in -# 1753 "parsing/parser.mly" +# 1756 "parsing/parser.mly" ( params ) -# 12572 "parsing/parser.ml" +# 12575 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12591,9 +12594,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = -# 2505 "parsing/parser.mly" +# 2508 "parsing/parser.mly" ( _1 ) -# 12597 "parsing/parser.ml" +# 12600 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12633,9 +12636,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2507 "parsing/parser.mly" +# 2510 "parsing/parser.mly" ( mkexp_constraint ~loc:_sloc _3 _1 ) -# 12639 "parsing/parser.ml" +# 12642 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12665,9 +12668,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2531 "parsing/parser.mly" +# 2534 "parsing/parser.mly" ( _2 ) -# 12671 "parsing/parser.ml" +# 12674 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12712,24 +12715,24 @@ module Tables = struct let _endpos = _endpos__4_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2533 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( Pexp_constraint (_4, _2) ) -# 12718 "parsing/parser.ml" +# 12721 "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" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12727 "parsing/parser.ml" +# 12730 "parsing/parser.ml" in -# 2534 "parsing/parser.mly" +# 2537 "parsing/parser.mly" ( _1 ) -# 12733 "parsing/parser.ml" +# 12736 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12762,12 +12765,12 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2537 "parsing/parser.mly" +# 2540 "parsing/parser.mly" ( let (l,o,p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) ) -# 12771 "parsing/parser.ml" +# 12774 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12818,17 +12821,17 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.expression) = let _3 = -# 2414 "parsing/parser.mly" +# 2417 "parsing/parser.mly" ( xs ) -# 12824 "parsing/parser.ml" +# 12827 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2542 "parsing/parser.mly" +# 2545 "parsing/parser.mly" ( mk_newtypes ~loc:_sloc _3 _5 ) -# 12832 "parsing/parser.ml" +# 12835 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12851,9 +12854,9 @@ module Tables = struct let _startpos = _startpos_ty_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.core_type) = -# 3226 "parsing/parser.mly" +# 3229 "parsing/parser.mly" ( ty ) -# 12857 "parsing/parser.ml" +# 12860 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12899,19 +12902,19 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let domain = -# 811 "parsing/parser.mly" +# 814 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 12905 "parsing/parser.ml" +# 12908 "parsing/parser.ml" in let label = -# 3238 "parsing/parser.mly" +# 3241 "parsing/parser.mly" ( Optional label ) -# 12910 "parsing/parser.ml" +# 12913 "parsing/parser.ml" in -# 3232 "parsing/parser.mly" +# 3235 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 12915 "parsing/parser.ml" +# 12918 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -12919,15 +12922,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 12925 "parsing/parser.ml" +# 12928 "parsing/parser.ml" in -# 3234 "parsing/parser.mly" +# 3237 "parsing/parser.mly" ( _1 ) -# 12931 "parsing/parser.ml" +# 12934 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12974,9 +12977,9 @@ module Tables = struct let _1 : (Parsetree.core_type) = Obj.magic _1 in let _2 : unit = Obj.magic _2 in let label : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 12980 "parsing/parser.ml" +# 12983 "parsing/parser.ml" ) = Obj.magic label in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_label_ in @@ -12984,19 +12987,19 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let domain = -# 811 "parsing/parser.mly" +# 814 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 12990 "parsing/parser.ml" +# 12993 "parsing/parser.ml" in let label = -# 3240 "parsing/parser.mly" +# 3243 "parsing/parser.mly" ( Labelled label ) -# 12995 "parsing/parser.ml" +# 12998 "parsing/parser.ml" in -# 3232 "parsing/parser.mly" +# 3235 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 13000 "parsing/parser.ml" +# 13003 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -13004,15 +13007,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 13010 "parsing/parser.ml" +# 13013 "parsing/parser.ml" in -# 3234 "parsing/parser.mly" +# 3237 "parsing/parser.mly" ( _1 ) -# 13016 "parsing/parser.ml" +# 13019 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13051,19 +13054,19 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let domain = -# 811 "parsing/parser.mly" +# 814 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 13057 "parsing/parser.ml" +# 13060 "parsing/parser.ml" in let label = -# 3242 "parsing/parser.mly" +# 3245 "parsing/parser.mly" ( Nolabel ) -# 13062 "parsing/parser.ml" +# 13065 "parsing/parser.ml" in -# 3232 "parsing/parser.mly" +# 3235 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 13067 "parsing/parser.ml" +# 13070 "parsing/parser.ml" in let _endpos__1_ = _endpos_codomain_ in @@ -13071,15 +13074,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 13077 "parsing/parser.ml" +# 13080 "parsing/parser.ml" in -# 3234 "parsing/parser.mly" +# 3237 "parsing/parser.mly" ( _1 ) -# 13083 "parsing/parser.ml" +# 13086 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13109,9 +13112,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.functor_parameter) = -# 1186 "parsing/parser.mly" +# 1189 "parsing/parser.mly" ( Unit ) -# 13115 "parsing/parser.ml" +# 13118 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13167,15 +13170,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13173 "parsing/parser.ml" +# 13176 "parsing/parser.ml" in -# 1189 "parsing/parser.mly" +# 1192 "parsing/parser.mly" ( Named (x, mty) ) -# 13179 "parsing/parser.ml" +# 13182 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13191,9 +13194,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 3034 "parsing/parser.mly" +# 3037 "parsing/parser.mly" ( (Pcstr_tuple [],None) ) -# 13197 "parsing/parser.ml" +# 13200 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13223,9 +13226,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 3035 "parsing/parser.mly" +# 3038 "parsing/parser.mly" ( (_2,None) ) -# 13229 "parsing/parser.ml" +# 13232 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13269,9 +13272,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 3037 "parsing/parser.mly" +# 3040 "parsing/parser.mly" ( (_2,Some _4) ) -# 13275 "parsing/parser.ml" +# 13278 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13301,9 +13304,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 3039 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( (Pcstr_tuple [],Some _2) ) -# 13307 "parsing/parser.ml" +# 13310 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13351,9 +13354,9 @@ module Tables = struct Docstrings.info) = let attrs = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 13357 "parsing/parser.ml" +# 13360 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined2_ in @@ -13363,23 +13366,23 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13369 "parsing/parser.ml" +# 13372 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2982 "parsing/parser.mly" +# 2985 "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 ) -# 13383 "parsing/parser.ml" +# 13386 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13420,9 +13423,9 @@ module Tables = struct Docstrings.info) = let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 13426 "parsing/parser.ml" +# 13429 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined1_ in @@ -13431,29 +13434,29 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13437 "parsing/parser.ml" +# 13440 "parsing/parser.ml" in let _startpos_cid_ = _startpos__1_ in let _1 = -# 3565 "parsing/parser.mly" +# 3568 "parsing/parser.mly" ( () ) -# 13444 "parsing/parser.ml" +# 13447 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos_cid_ in let _sloc = (_symbolstartpos, _endpos) in -# 2982 "parsing/parser.mly" +# 2985 "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 ) -# 13457 "parsing/parser.ml" +# 13460 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13524,9 +13527,9 @@ module Tables = struct let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in let _1_inlined3 : unit = Obj.magic _1_inlined3 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 13530 "parsing/parser.ml" +# 13533 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -13539,9 +13542,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 13545 "parsing/parser.ml" +# 13548 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -13550,26 +13553,26 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13554 "parsing/parser.ml" +# 13557 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 13559 "parsing/parser.ml" +# 13562 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 13565 "parsing/parser.ml" +# 13568 "parsing/parser.ml" in let kind_priv_manifest = let _1 = _1_inlined3 in -# 2922 "parsing/parser.mly" +# 2925 "parsing/parser.mly" ( _2 ) -# 13573 "parsing/parser.ml" +# 13576 "parsing/parser.ml" in let id = @@ -13578,29 +13581,29 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13584 "parsing/parser.ml" +# 13587 "parsing/parser.ml" in let flag = -# 3585 "parsing/parser.mly" +# 3588 "parsing/parser.mly" ( Recursive ) -# 13590 "parsing/parser.ml" +# 13593 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 13597 "parsing/parser.ml" +# 13600 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2859 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -13609,7 +13612,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 13613 "parsing/parser.ml" +# 13616 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13686,9 +13689,9 @@ module Tables = struct let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in let _1_inlined4 : unit = Obj.magic _1_inlined4 in let _1_inlined3 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 13692 "parsing/parser.ml" +# 13695 "parsing/parser.ml" ) = Obj.magic _1_inlined3 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let _1_inlined2 : unit = Obj.magic _1_inlined2 in @@ -13702,9 +13705,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined5 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 13708 "parsing/parser.ml" +# 13711 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined5_ in @@ -13713,26 +13716,26 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13717 "parsing/parser.ml" +# 13720 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 13722 "parsing/parser.ml" +# 13725 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 13728 "parsing/parser.ml" +# 13731 "parsing/parser.ml" in let kind_priv_manifest = let _1 = _1_inlined4 in -# 2922 "parsing/parser.mly" +# 2925 "parsing/parser.mly" ( _2 ) -# 13736 "parsing/parser.ml" +# 13739 "parsing/parser.ml" in let id = @@ -13741,9 +13744,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13747 "parsing/parser.ml" +# 13750 "parsing/parser.ml" in let flag = @@ -13752,24 +13755,24 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3586 "parsing/parser.mly" +# 3589 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 13758 "parsing/parser.ml" +# 13761 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 13766 "parsing/parser.ml" +# 13769 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2859 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -13778,7 +13781,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 13782 "parsing/parser.ml" +# 13785 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13842,9 +13845,9 @@ module Tables = struct let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 13848 "parsing/parser.ml" +# 13851 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -13857,9 +13860,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 13863 "parsing/parser.ml" +# 13866 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -13868,18 +13871,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 13872 "parsing/parser.ml" +# 13875 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 13877 "parsing/parser.ml" +# 13880 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 13883 "parsing/parser.ml" +# 13886 "parsing/parser.ml" in let id = @@ -13888,29 +13891,29 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13894 "parsing/parser.ml" +# 13897 "parsing/parser.ml" in let flag = -# 3581 "parsing/parser.mly" +# 3584 "parsing/parser.mly" ( Recursive ) -# 13900 "parsing/parser.ml" +# 13903 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 13907 "parsing/parser.ml" +# 13910 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2859 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -13919,7 +13922,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 13923 "parsing/parser.ml" +# 13926 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13989,9 +13992,9 @@ module Tables = struct let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in let _1_inlined3 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 13995 "parsing/parser.ml" +# 13998 "parsing/parser.ml" ) = Obj.magic _1_inlined3 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let _1_inlined2 : unit = Obj.magic _1_inlined2 in @@ -14005,9 +14008,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 14011 "parsing/parser.ml" +# 14014 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -14016,18 +14019,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 14020 "parsing/parser.ml" +# 14023 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 14025 "parsing/parser.ml" +# 14028 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 14031 "parsing/parser.ml" +# 14034 "parsing/parser.ml" in let id = @@ -14036,32 +14039,32 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14042 "parsing/parser.ml" +# 14045 "parsing/parser.ml" in let flag = let _1 = _1_inlined2 in -# 3582 "parsing/parser.mly" +# 3585 "parsing/parser.mly" ( Nonrecursive ) -# 14050 "parsing/parser.ml" +# 14053 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 14058 "parsing/parser.ml" +# 14061 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2859 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -14070,7 +14073,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 14074 "parsing/parser.ml" +# 14077 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14089,17 +14092,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 14095 "parsing/parser.ml" +# 14098 "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) = -# 3426 "parsing/parser.mly" +# 3429 "parsing/parser.mly" ( _1 ) -# 14103 "parsing/parser.ml" +# 14106 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14118,17 +14121,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 14124 "parsing/parser.ml" +# 14127 "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) = -# 3427 "parsing/parser.mly" +# 3430 "parsing/parser.mly" ( _1 ) -# 14132 "parsing/parser.ml" +# 14135 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14158,13 +14161,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 777 "parsing/parser.mly" +# 780 "parsing/parser.mly" (Parsetree.structure) -# 14164 "parsing/parser.ml" +# 14167 "parsing/parser.ml" ) = -# 1068 "parsing/parser.mly" +# 1071 "parsing/parser.mly" ( _1 ) -# 14168 "parsing/parser.ml" +# 14171 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14180,9 +14183,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (string) = -# 3476 "parsing/parser.mly" +# 3479 "parsing/parser.mly" ( "" ) -# 14186 "parsing/parser.ml" +# 14189 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14212,9 +14215,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (string) = -# 3477 "parsing/parser.mly" +# 3480 "parsing/parser.mly" ( ";.." ) -# 14218 "parsing/parser.ml" +# 14221 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14244,13 +14247,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 779 "parsing/parser.mly" +# 782 "parsing/parser.mly" (Parsetree.signature) -# 14250 "parsing/parser.ml" +# 14253 "parsing/parser.ml" ) = -# 1074 "parsing/parser.mly" +# 1077 "parsing/parser.mly" ( _1 ) -# 14254 "parsing/parser.ml" +# 14257 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14294,9 +14297,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.extension) = -# 3761 "parsing/parser.mly" +# 3764 "parsing/parser.mly" ( (_2, _3) ) -# 14300 "parsing/parser.ml" +# 14303 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14315,9 +14318,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 689 "parsing/parser.mly" +# 692 "parsing/parser.mly" (string * Location.t * string * Location.t * string option) -# 14321 "parsing/parser.ml" +# 14324 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -14326,9 +14329,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3763 "parsing/parser.mly" +# 3766 "parsing/parser.mly" ( mk_quotedext ~loc:_sloc _1 ) -# 14332 "parsing/parser.ml" +# 14335 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14374,9 +14377,9 @@ module Tables = struct 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" +# 650 "parsing/parser.mly" (string) -# 14380 "parsing/parser.ml" +# 14383 "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 @@ -14385,34 +14388,34 @@ module Tables = struct let _v : (Parsetree.label_declaration) = let _5 = let _1 = _1_inlined3 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 14391 "parsing/parser.ml" +# 14394 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3179 "parsing/parser.mly" +# 3182 "parsing/parser.mly" ( _1 ) -# 14400 "parsing/parser.ml" +# 14403 "parsing/parser.ml" in let _2 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 14408 "parsing/parser.ml" +# 14411 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14416 "parsing/parser.ml" +# 14419 "parsing/parser.ml" in let _startpos__2_ = _startpos__1_inlined1_ in @@ -14423,10 +14426,10 @@ module Tables = struct _startpos__2_ in let _sloc = (_symbolstartpos, _endpos) in -# 3056 "parsing/parser.mly" +# 3059 "parsing/parser.mly" ( let info = symbol_info _endpos in Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info ) -# 14430 "parsing/parser.ml" +# 14433 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14486,9 +14489,9 @@ module Tables = struct 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" +# 650 "parsing/parser.mly" (string) -# 14492 "parsing/parser.ml" +# 14495 "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 @@ -14497,43 +14500,43 @@ module Tables = struct let _v : (Parsetree.label_declaration) = let _7 = let _1 = _1_inlined4 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 14503 "parsing/parser.ml" +# 14506 "parsing/parser.ml" in let _endpos__7_ = _endpos__1_inlined4_ in let _5 = let _1 = _1_inlined3 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 14512 "parsing/parser.ml" +# 14515 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3179 "parsing/parser.mly" +# 3182 "parsing/parser.mly" ( _1 ) -# 14521 "parsing/parser.ml" +# 14524 "parsing/parser.ml" in let _2 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 14529 "parsing/parser.ml" +# 14532 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14537 "parsing/parser.ml" +# 14540 "parsing/parser.ml" in let _startpos__2_ = _startpos__1_inlined1_ in @@ -14544,14 +14547,14 @@ module Tables = struct _startpos__2_ in let _sloc = (_symbolstartpos, _endpos) in -# 3061 "parsing/parser.mly" +# 3064 "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 ) -# 14555 "parsing/parser.ml" +# 14558 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14574,9 +14577,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.label_declaration list) = -# 3050 "parsing/parser.mly" +# 3053 "parsing/parser.mly" ( [_1] ) -# 14580 "parsing/parser.ml" +# 14583 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14599,9 +14602,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.label_declaration list) = -# 3051 "parsing/parser.mly" +# 3054 "parsing/parser.mly" ( [_1] ) -# 14605 "parsing/parser.ml" +# 14608 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14631,9 +14634,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.label_declaration list) = -# 3052 "parsing/parser.mly" +# 3055 "parsing/parser.mly" ( _1 :: _2 ) -# 14637 "parsing/parser.ml" +# 14640 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14652,9 +14655,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 14658 "parsing/parser.ml" +# 14661 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -14665,24 +14668,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14671 "parsing/parser.ml" +# 14674 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2123 "parsing/parser.mly" +# 2126 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 14680 "parsing/parser.ml" +# 14683 "parsing/parser.ml" in -# 2115 "parsing/parser.mly" +# 2118 "parsing/parser.mly" ( x ) -# 14686 "parsing/parser.ml" +# 14689 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14715,9 +14718,9 @@ module Tables = struct let cty : (Parsetree.core_type) = Obj.magic cty in let _2 : unit = Obj.magic _2 in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 14721 "parsing/parser.ml" +# 14724 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -14728,18 +14731,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14734 "parsing/parser.ml" +# 14737 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2123 "parsing/parser.mly" +# 2126 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 14743 "parsing/parser.ml" +# 14746 "parsing/parser.ml" in let _startpos_x_ = _startpos__1_ in @@ -14747,11 +14750,11 @@ module Tables = struct let _symbolstartpos = _startpos_x_ in let _sloc = (_symbolstartpos, _endpos) in -# 2117 "parsing/parser.mly" +# 2120 "parsing/parser.mly" ( let lab, pat = x in lab, mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) ) -# 14755 "parsing/parser.ml" +# 14758 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14774,9 +14777,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3508 "parsing/parser.mly" +# 3511 "parsing/parser.mly" ( _1 ) -# 14780 "parsing/parser.ml" +# 14783 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14799,9 +14802,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.arg_label * Parsetree.expression) = -# 2400 "parsing/parser.mly" +# 2403 "parsing/parser.mly" ( (Nolabel, _1) ) -# 14805 "parsing/parser.ml" +# 14808 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14827,17 +14830,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.expression) = Obj.magic _2 in let _1 : ( -# 634 "parsing/parser.mly" +# 637 "parsing/parser.mly" (string) -# 14833 "parsing/parser.ml" +# 14836 "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" +# 2405 "parsing/parser.mly" ( (Labelled _1, _2) ) -# 14841 "parsing/parser.ml" +# 14844 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14862,47 +14865,9 @@ module Tables = struct }; } = _menhir_stack in let label : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 14868 "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) ) -# 14879 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 14906 "parsing/parser.ml" +# 14871 "parsing/parser.ml" ) = Obj.magic label in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -14911,9 +14876,47 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in # 2407 "parsing/parser.mly" + ( let loc = _loc_label_ in + (Labelled label, mkexpvar ~loc label) ) +# 14882 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 650 "parsing/parser.mly" + (string) +# 14909 "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 + +# 2410 "parsing/parser.mly" ( let loc = _loc_label_ in (Optional label, mkexpvar ~loc label) ) -# 14917 "parsing/parser.ml" +# 14920 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14939,17 +14942,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.expression) = Obj.magic _2 in let _1 : ( -# 664 "parsing/parser.mly" +# 667 "parsing/parser.mly" (string) -# 14945 "parsing/parser.ml" +# 14948 "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" +# 2413 "parsing/parser.mly" ( (Optional _1, _2) ) -# 14953 "parsing/parser.ml" +# 14956 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15002,15 +15005,15 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 = let _1 = _1_inlined1 in -# 2111 "parsing/parser.mly" +# 2114 "parsing/parser.mly" ( _1 ) -# 15008 "parsing/parser.ml" +# 15011 "parsing/parser.ml" in -# 2085 "parsing/parser.mly" +# 2088 "parsing/parser.mly" ( (Optional (fst _3), _4, snd _3) ) -# 15014 "parsing/parser.ml" +# 15017 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15035,9 +15038,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 15041 "parsing/parser.ml" +# 15044 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -15050,24 +15053,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 15056 "parsing/parser.ml" +# 15059 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2123 "parsing/parser.mly" +# 2126 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 15065 "parsing/parser.ml" +# 15068 "parsing/parser.ml" in -# 2087 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( (Optional (fst _2), None, snd _2) ) -# 15071 "parsing/parser.ml" +# 15074 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15114,9 +15117,9 @@ module Tables = struct let _3 : (Parsetree.pattern) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 664 "parsing/parser.mly" +# 667 "parsing/parser.mly" (string) -# 15120 "parsing/parser.ml" +# 15123 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -15124,15 +15127,15 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 = let _1 = _1_inlined1 in -# 2111 "parsing/parser.mly" +# 2114 "parsing/parser.mly" ( _1 ) -# 15130 "parsing/parser.ml" +# 15133 "parsing/parser.ml" in -# 2089 "parsing/parser.mly" +# 2092 "parsing/parser.mly" ( (Optional _1, _4, _3) ) -# 15136 "parsing/parser.ml" +# 15139 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15158,17 +15161,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.pattern) = Obj.magic _2 in let _1 : ( -# 664 "parsing/parser.mly" +# 667 "parsing/parser.mly" (string) -# 15164 "parsing/parser.ml" +# 15167 "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" +# 2094 "parsing/parser.mly" ( (Optional _1, None, _2) ) -# 15172 "parsing/parser.ml" +# 15175 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15212,9 +15215,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = -# 2093 "parsing/parser.mly" +# 2096 "parsing/parser.mly" ( (Labelled (fst _3), None, snd _3) ) -# 15218 "parsing/parser.ml" +# 15221 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15239,9 +15242,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 15245 "parsing/parser.ml" +# 15248 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -15254,24 +15257,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 15260 "parsing/parser.ml" +# 15263 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2123 "parsing/parser.mly" +# 2126 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 15269 "parsing/parser.ml" +# 15272 "parsing/parser.ml" in -# 2095 "parsing/parser.mly" +# 2098 "parsing/parser.mly" ( (Labelled (fst _2), None, snd _2) ) -# 15275 "parsing/parser.ml" +# 15278 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15297,17 +15300,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.pattern) = Obj.magic _2 in let _1 : ( -# 634 "parsing/parser.mly" +# 637 "parsing/parser.mly" (string) -# 15303 "parsing/parser.ml" +# 15306 "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" +# 2100 "parsing/parser.mly" ( (Labelled _1, None, _2) ) -# 15311 "parsing/parser.ml" +# 15314 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15330,9 +15333,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = -# 2099 "parsing/parser.mly" +# 2102 "parsing/parser.mly" ( (Nolabel, None, _1) ) -# 15336 "parsing/parser.ml" +# 15339 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15366,15 +15369,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2417 "parsing/parser.mly" +# 2420 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15372 "parsing/parser.ml" +# 15375 "parsing/parser.ml" in -# 2421 "parsing/parser.mly" +# 2424 "parsing/parser.mly" ( (_1, _2) ) -# 15378 "parsing/parser.ml" +# 15381 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15422,16 +15425,16 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2417 "parsing/parser.mly" +# 2420 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15428 "parsing/parser.ml" +# 15431 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2423 "parsing/parser.mly" +# 2426 "parsing/parser.mly" ( let v = _1 in (* PR#7344 *) let t = match _2 with @@ -15444,7 +15447,7 @@ module Tables = struct let patloc = (_startpos__1_, _endpos__2_) in (ghpat ~loc:patloc (Ppat_constraint(v, typ)), mkexp_constraint ~loc:_sloc _4 _2) ) -# 15448 "parsing/parser.ml" +# 15451 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15513,18 +15516,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 15517 "parsing/parser.ml" +# 15520 "parsing/parser.ml" in -# 915 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 15522 "parsing/parser.ml" +# 15525 "parsing/parser.ml" in -# 3161 "parsing/parser.mly" +# 3164 "parsing/parser.mly" ( _1 ) -# 15528 "parsing/parser.ml" +# 15531 "parsing/parser.ml" in let _startpos__3_ = _startpos_xs_ in @@ -15533,19 +15536,19 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2417 "parsing/parser.mly" +# 2420 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15539 "parsing/parser.ml" +# 15542 "parsing/parser.ml" in -# 2439 "parsing/parser.mly" +# 2442 "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) ) -# 15549 "parsing/parser.ml" +# 15552 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15617,30 +15620,30 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__8_ in let _v : (Parsetree.pattern * Parsetree.expression) = let _4 = -# 2414 "parsing/parser.mly" +# 2417 "parsing/parser.mly" ( xs ) -# 15623 "parsing/parser.ml" +# 15626 "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" +# 2420 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15632 "parsing/parser.ml" +# 15635 "parsing/parser.ml" in let _endpos = _endpos__8_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2445 "parsing/parser.mly" +# 2448 "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) ) -# 15644 "parsing/parser.ml" +# 15647 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15677,9 +15680,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2450 "parsing/parser.mly" +# 2453 "parsing/parser.mly" ( (_1, _3) ) -# 15683 "parsing/parser.ml" +# 15686 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15730,10 +15733,10 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2452 "parsing/parser.mly" +# 2455 "parsing/parser.mly" ( let loc = (_startpos__1_, _endpos__3_) in (ghpat ~loc (Ppat_constraint(_1, _3)), _5) ) -# 15737 "parsing/parser.ml" +# 15740 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15794,36 +15797,36 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 15800 "parsing/parser.ml" +# 15803 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 15809 "parsing/parser.ml" +# 15812 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2468 "parsing/parser.mly" +# 2471 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 15821 "parsing/parser.ml" +# 15824 "parsing/parser.ml" in -# 2458 "parsing/parser.mly" +# 2461 "parsing/parser.mly" ( _1 ) -# 15827 "parsing/parser.ml" +# 15830 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15853,9 +15856,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (let_bindings) = -# 2459 "parsing/parser.mly" +# 2462 "parsing/parser.mly" ( addlb _1 _2 ) -# 15859 "parsing/parser.ml" +# 15862 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15909,41 +15912,41 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 15915 "parsing/parser.ml" +# 15918 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 15924 "parsing/parser.ml" +# 15927 "parsing/parser.ml" in let ext = -# 3749 "parsing/parser.mly" +# 3752 "parsing/parser.mly" ( None ) -# 15930 "parsing/parser.ml" +# 15933 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2468 "parsing/parser.mly" +# 2471 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 15941 "parsing/parser.ml" +# 15944 "parsing/parser.ml" in -# 2458 "parsing/parser.mly" +# 2461 "parsing/parser.mly" ( _1 ) -# 15947 "parsing/parser.ml" +# 15950 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16011,18 +16014,18 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 16017 "parsing/parser.ml" +# 16020 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let attrs1 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 16026 "parsing/parser.ml" +# 16029 "parsing/parser.ml" in let ext = @@ -16031,27 +16034,27 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3750 "parsing/parser.mly" +# 3753 "parsing/parser.mly" ( not_expecting _loc "extension" ) -# 16037 "parsing/parser.ml" +# 16040 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2468 "parsing/parser.mly" +# 2471 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 16049 "parsing/parser.ml" +# 16052 "parsing/parser.ml" in -# 2458 "parsing/parser.mly" +# 2461 "parsing/parser.mly" ( _1 ) -# 16055 "parsing/parser.ml" +# 16058 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16081,9 +16084,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (let_bindings) = -# 2459 "parsing/parser.mly" +# 2462 "parsing/parser.mly" ( addlb _1 _2 ) -# 16087 "parsing/parser.ml" +# 16090 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16106,9 +16109,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2127 "parsing/parser.mly" +# 2130 "parsing/parser.mly" ( _1 ) -# 16112 "parsing/parser.ml" +# 16115 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16146,24 +16149,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2129 "parsing/parser.mly" +# 2132 "parsing/parser.mly" ( Ppat_constraint(_1, _3) ) -# 16152 "parsing/parser.ml" +# 16155 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 16161 "parsing/parser.ml" +# 16164 "parsing/parser.ml" in -# 2130 "parsing/parser.mly" +# 2133 "parsing/parser.mly" ( _1 ) -# 16167 "parsing/parser.ml" +# 16170 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16197,15 +16200,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2417 "parsing/parser.mly" +# 2420 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 16203 "parsing/parser.ml" +# 16206 "parsing/parser.ml" in -# 2485 "parsing/parser.mly" +# 2488 "parsing/parser.mly" ( (pat, exp) ) -# 16209 "parsing/parser.ml" +# 16212 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16256,10 +16259,10 @@ module Tables = struct let _startpos = _startpos_pat_ in let _endpos = _endpos_exp_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2487 "parsing/parser.mly" +# 2490 "parsing/parser.mly" ( let loc = (_startpos_pat_, _endpos_typ_) in (ghpat ~loc (Ppat_constraint(pat, typ)), exp) ) -# 16263 "parsing/parser.ml" +# 16266 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16296,9 +16299,9 @@ module Tables = struct let _startpos = _startpos_pat_ in let _endpos = _endpos_exp_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2490 "parsing/parser.mly" +# 2493 "parsing/parser.mly" ( (pat, exp) ) -# 16302 "parsing/parser.ml" +# 16305 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16321,10 +16324,10 @@ module Tables = struct let _startpos = _startpos_body_ in let _endpos = _endpos_body_ in let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = -# 2494 "parsing/parser.mly" +# 2497 "parsing/parser.mly" ( let let_pat, let_exp = body in let_pat, let_exp, [] ) -# 16328 "parsing/parser.ml" +# 16331 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16356,9 +16359,9 @@ module Tables = struct } = _menhir_stack in let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in let _1 : ( -# 630 "parsing/parser.mly" +# 633 "parsing/parser.mly" (string) -# 16362 "parsing/parser.ml" +# 16365 "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 @@ -16369,22 +16372,22 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16375 "parsing/parser.ml" +# 16378 "parsing/parser.ml" in let _endpos = _endpos_body_ in let _symbolstartpos = _startpos_bindings_ in let _sloc = (_symbolstartpos, _endpos) in -# 2497 "parsing/parser.mly" +# 2500 "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 ) -# 16388 "parsing/parser.ml" +# 16391 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16402,7 +16405,7 @@ module Tables = struct let _v : (Parsetree.class_declaration list) = # 211 "" ( [] ) -# 16406 "parsing/parser.ml" +# 16409 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16466,9 +16469,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.class_expr) = Obj.magic body in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 16472 "parsing/parser.ml" +# 16475 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -16481,9 +16484,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 16487 "parsing/parser.ml" +# 16490 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16493,24 +16496,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16499 "parsing/parser.ml" +# 16502 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 16507 "parsing/parser.ml" +# 16510 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1731 "parsing/parser.mly" +# 1734 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -16518,13 +16521,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs ) -# 16522 "parsing/parser.ml" +# 16525 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 16528 "parsing/parser.ml" +# 16531 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16542,7 +16545,7 @@ module Tables = struct let _v : (Parsetree.class_description list) = # 211 "" ( [] ) -# 16546 "parsing/parser.ml" +# 16549 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16613,9 +16616,9 @@ module Tables = struct let cty : (Parsetree.class_type) = Obj.magic cty in let _6 : unit = Obj.magic _6 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 16619 "parsing/parser.ml" +# 16622 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -16628,9 +16631,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 16634 "parsing/parser.ml" +# 16637 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16640,24 +16643,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16646 "parsing/parser.ml" +# 16649 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 16654 "parsing/parser.ml" +# 16657 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2022 "parsing/parser.mly" +# 2025 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -16665,13 +16668,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs ) -# 16669 "parsing/parser.ml" +# 16672 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 16675 "parsing/parser.ml" +# 16678 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16689,7 +16692,7 @@ module Tables = struct let _v : (Parsetree.class_type_declaration list) = # 211 "" ( [] ) -# 16693 "parsing/parser.ml" +# 16696 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16760,9 +16763,9 @@ module Tables = struct let csig : (Parsetree.class_type) = Obj.magic csig in let _6 : unit = Obj.magic _6 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 16766 "parsing/parser.ml" +# 16769 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -16775,9 +16778,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 16781 "parsing/parser.ml" +# 16784 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16787,24 +16790,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16793 "parsing/parser.ml" +# 16796 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 16801 "parsing/parser.ml" +# 16804 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2061 "parsing/parser.mly" +# 2064 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -16812,13 +16815,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs ) -# 16816 "parsing/parser.ml" +# 16819 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 16822 "parsing/parser.ml" +# 16825 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16836,7 +16839,7 @@ module Tables = struct let _v : (Parsetree.module_binding list) = # 211 "" ( [] ) -# 16840 "parsing/parser.ml" +# 16843 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16897,9 +16900,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 16903 "parsing/parser.ml" +# 16906 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16909,24 +16912,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16915 "parsing/parser.ml" +# 16918 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 16923 "parsing/parser.ml" +# 16926 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1413 "parsing/parser.mly" +# 1416 "parsing/parser.mly" ( let loc = make_loc _sloc in let attrs = attrs1 @ attrs2 in @@ -16934,13 +16937,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Mb.mk name body ~attrs ~loc ~text ~docs ) -# 16938 "parsing/parser.ml" +# 16941 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 16944 "parsing/parser.ml" +# 16947 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16958,7 +16961,7 @@ module Tables = struct let _v : (Parsetree.module_declaration list) = # 211 "" ( [] ) -# 16962 "parsing/parser.ml" +# 16965 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17026,9 +17029,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 17032 "parsing/parser.ml" +# 17035 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -17038,24 +17041,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 17044 "parsing/parser.ml" +# 17047 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 17052 "parsing/parser.ml" +# 17055 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1689 "parsing/parser.mly" +# 1692 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let docs = symbol_docs _sloc in @@ -17063,13 +17066,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Md.mk name mty ~attrs ~loc ~text ~docs ) -# 17067 "parsing/parser.ml" +# 17070 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17073 "parsing/parser.ml" +# 17076 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17087,7 +17090,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 211 "" ( [] ) -# 17091 "parsing/parser.ml" +# 17094 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17119,7 +17122,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 213 "" ( x :: xs ) -# 17123 "parsing/parser.ml" +# 17126 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17137,7 +17140,7 @@ module Tables = struct let _v : (Parsetree.type_declaration list) = # 211 "" ( [] ) -# 17141 "parsing/parser.ml" +# 17144 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17202,9 +17205,9 @@ module Tables = struct let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 17208 "parsing/parser.ml" +# 17211 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -17217,9 +17220,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 17223 "parsing/parser.ml" +# 17226 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -17228,18 +17231,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 17232 "parsing/parser.ml" +# 17235 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 17237 "parsing/parser.ml" +# 17240 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 17243 "parsing/parser.ml" +# 17246 "parsing/parser.ml" in let id = @@ -17248,24 +17251,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 17254 "parsing/parser.ml" +# 17257 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 17262 "parsing/parser.ml" +# 17265 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2876 "parsing/parser.mly" +# 2879 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -17274,13 +17277,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text ) -# 17278 "parsing/parser.ml" +# 17281 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17284 "parsing/parser.ml" +# 17287 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17298,7 +17301,7 @@ module Tables = struct let _v : (Parsetree.type_declaration list) = # 211 "" ( [] ) -# 17302 "parsing/parser.ml" +# 17305 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17370,9 +17373,9 @@ module Tables = struct let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in let _1_inlined3 : unit = Obj.magic _1_inlined3 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 17376 "parsing/parser.ml" +# 17379 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -17385,9 +17388,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 17391 "parsing/parser.ml" +# 17394 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -17396,26 +17399,26 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 17400 "parsing/parser.ml" +# 17403 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 17405 "parsing/parser.ml" +# 17408 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 17411 "parsing/parser.ml" +# 17414 "parsing/parser.ml" in let kind_priv_manifest = let _1 = _1_inlined3 in -# 2922 "parsing/parser.mly" +# 2925 "parsing/parser.mly" ( _2 ) -# 17419 "parsing/parser.ml" +# 17422 "parsing/parser.ml" in let id = @@ -17424,24 +17427,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 17430 "parsing/parser.ml" +# 17433 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 17438 "parsing/parser.ml" +# 17441 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2876 "parsing/parser.mly" +# 2879 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -17450,13 +17453,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text ) -# 17454 "parsing/parser.ml" +# 17457 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17460 "parsing/parser.ml" +# 17463 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17474,7 +17477,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 211 "" ( [] ) -# 17478 "parsing/parser.ml" +# 17481 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17506,7 +17509,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 213 "" ( x :: xs ) -# 17510 "parsing/parser.ml" +# 17513 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17524,7 +17527,7 @@ module Tables = struct let _v : (Parsetree.signature_item list list) = # 211 "" ( [] ) -# 17528 "parsing/parser.ml" +# 17531 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17557,21 +17560,21 @@ module Tables = struct let _1 = let _startpos = _startpos__1_ in -# 823 "parsing/parser.mly" +# 826 "parsing/parser.mly" ( text_sig _startpos ) -# 17563 "parsing/parser.ml" +# 17566 "parsing/parser.ml" in -# 1551 "parsing/parser.mly" +# 1554 "parsing/parser.mly" ( _1 ) -# 17569 "parsing/parser.ml" +# 17572 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17575 "parsing/parser.ml" +# 17578 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17604,21 +17607,21 @@ module Tables = struct let _1 = let _startpos = _startpos__1_ in -# 821 "parsing/parser.mly" +# 824 "parsing/parser.mly" ( text_sig _startpos @ [_1] ) -# 17610 "parsing/parser.ml" +# 17613 "parsing/parser.ml" in -# 1551 "parsing/parser.mly" +# 1554 "parsing/parser.mly" ( _1 ) -# 17616 "parsing/parser.ml" +# 17619 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17622 "parsing/parser.ml" +# 17625 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17636,7 +17639,7 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = # 211 "" ( [] ) -# 17640 "parsing/parser.ml" +# 17643 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17669,40 +17672,40 @@ module Tables = struct let _1 = let ys = let items = -# 883 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( [] ) -# 17675 "parsing/parser.ml" +# 17678 "parsing/parser.ml" in -# 1297 "parsing/parser.mly" +# 1300 "parsing/parser.mly" ( items ) -# 17680 "parsing/parser.ml" +# 17683 "parsing/parser.ml" in let xs = let _startpos = _startpos__1_ in -# 819 "parsing/parser.mly" +# 822 "parsing/parser.mly" ( text_str _startpos ) -# 17688 "parsing/parser.ml" +# 17691 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 17694 "parsing/parser.ml" +# 17697 "parsing/parser.ml" in -# 1313 "parsing/parser.mly" +# 1316 "parsing/parser.mly" ( _1 ) -# 17700 "parsing/parser.ml" +# 17703 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17706 "parsing/parser.ml" +# 17709 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17754,70 +17757,70 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 17760 "parsing/parser.ml" +# 17763 "parsing/parser.ml" in -# 1304 "parsing/parser.mly" +# 1307 "parsing/parser.mly" ( mkstrexp e attrs ) -# 17765 "parsing/parser.ml" +# 17768 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 817 "parsing/parser.mly" +# 820 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 17773 "parsing/parser.ml" +# 17776 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 836 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 17783 "parsing/parser.ml" +# 17786 "parsing/parser.ml" in -# 885 "parsing/parser.mly" +# 888 "parsing/parser.mly" ( x ) -# 17789 "parsing/parser.ml" +# 17792 "parsing/parser.ml" in -# 1297 "parsing/parser.mly" +# 1300 "parsing/parser.mly" ( items ) -# 17795 "parsing/parser.ml" +# 17798 "parsing/parser.ml" in let xs = let _startpos = _startpos__1_ in -# 819 "parsing/parser.mly" +# 822 "parsing/parser.mly" ( text_str _startpos ) -# 17803 "parsing/parser.ml" +# 17806 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 17809 "parsing/parser.ml" +# 17812 "parsing/parser.ml" in -# 1313 "parsing/parser.mly" +# 1316 "parsing/parser.mly" ( _1 ) -# 17815 "parsing/parser.ml" +# 17818 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17821 "parsing/parser.ml" +# 17824 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17850,21 +17853,21 @@ module Tables = struct let _1 = let _startpos = _startpos__1_ in -# 817 "parsing/parser.mly" +# 820 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 17856 "parsing/parser.ml" +# 17859 "parsing/parser.ml" in -# 1313 "parsing/parser.mly" +# 1316 "parsing/parser.mly" ( _1 ) -# 17862 "parsing/parser.ml" +# 17865 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17868 "parsing/parser.ml" +# 17871 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17882,7 +17885,7 @@ module Tables = struct let _v : (Parsetree.class_type_field list list) = # 211 "" ( [] ) -# 17886 "parsing/parser.ml" +# 17889 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17914,15 +17917,15 @@ module Tables = struct let _v : (Parsetree.class_type_field list list) = let x = let _startpos = _startpos__1_ in -# 831 "parsing/parser.mly" +# 834 "parsing/parser.mly" ( text_csig _startpos @ [_1] ) -# 17920 "parsing/parser.ml" +# 17923 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17926 "parsing/parser.ml" +# 17929 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17940,7 +17943,7 @@ module Tables = struct let _v : (Parsetree.class_field list list) = # 211 "" ( [] ) -# 17944 "parsing/parser.ml" +# 17947 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17972,15 +17975,15 @@ module Tables = struct let _v : (Parsetree.class_field list list) = let x = let _startpos = _startpos__1_ in -# 829 "parsing/parser.mly" +# 832 "parsing/parser.mly" ( text_cstr _startpos @ [_1] ) -# 17978 "parsing/parser.ml" +# 17981 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 17984 "parsing/parser.ml" +# 17987 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17998,7 +18001,7 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = # 211 "" ( [] ) -# 18002 "parsing/parser.ml" +# 18005 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18030,15 +18033,15 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = let x = let _startpos = _startpos__1_ in -# 817 "parsing/parser.mly" +# 820 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 18036 "parsing/parser.ml" +# 18039 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 18042 "parsing/parser.ml" +# 18045 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18056,7 +18059,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase list list) = # 211 "" ( [] ) -# 18060 "parsing/parser.ml" +# 18063 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18089,32 +18092,32 @@ module Tables = struct let _1 = let x = let _1 = -# 883 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( [] ) -# 18095 "parsing/parser.ml" +# 18098 "parsing/parser.ml" in -# 1113 "parsing/parser.mly" +# 1116 "parsing/parser.mly" ( _1 ) -# 18100 "parsing/parser.ml" +# 18103 "parsing/parser.ml" in # 183 "" ( x ) -# 18106 "parsing/parser.ml" +# 18109 "parsing/parser.ml" in -# 1125 "parsing/parser.mly" +# 1128 "parsing/parser.mly" ( _1 ) -# 18112 "parsing/parser.ml" +# 18115 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 18118 "parsing/parser.ml" +# 18121 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18166,58 +18169,58 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 18172 "parsing/parser.ml" +# 18175 "parsing/parser.ml" in -# 1304 "parsing/parser.mly" +# 1307 "parsing/parser.mly" ( mkstrexp e attrs ) -# 18177 "parsing/parser.ml" +# 18180 "parsing/parser.ml" in -# 827 "parsing/parser.mly" +# 830 "parsing/parser.mly" ( Ptop_def [_1] ) -# 18183 "parsing/parser.ml" +# 18186 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 825 "parsing/parser.mly" +# 828 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 18191 "parsing/parser.ml" +# 18194 "parsing/parser.ml" in -# 885 "parsing/parser.mly" +# 888 "parsing/parser.mly" ( x ) -# 18197 "parsing/parser.ml" +# 18200 "parsing/parser.ml" in -# 1113 "parsing/parser.mly" +# 1116 "parsing/parser.mly" ( _1 ) -# 18203 "parsing/parser.ml" +# 18206 "parsing/parser.ml" in # 183 "" ( x ) -# 18209 "parsing/parser.ml" +# 18212 "parsing/parser.ml" in -# 1125 "parsing/parser.mly" +# 1128 "parsing/parser.mly" ( _1 ) -# 18215 "parsing/parser.ml" +# 18218 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 18221 "parsing/parser.ml" +# 18224 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18249,27 +18252,27 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase list list) = let x = let _1 = let _1 = -# 827 "parsing/parser.mly" +# 830 "parsing/parser.mly" ( Ptop_def [_1] ) -# 18255 "parsing/parser.ml" +# 18258 "parsing/parser.ml" in let _startpos = _startpos__1_ in -# 825 "parsing/parser.mly" +# 828 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 18261 "parsing/parser.ml" +# 18264 "parsing/parser.ml" in -# 1125 "parsing/parser.mly" +# 1128 "parsing/parser.mly" ( _1 ) -# 18267 "parsing/parser.ml" +# 18270 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 18273 "parsing/parser.ml" +# 18276 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18304,29 +18307,29 @@ module Tables = struct let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 836 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 18311 "parsing/parser.ml" +# 18314 "parsing/parser.ml" in let _startpos = _startpos__1_ in -# 825 "parsing/parser.mly" +# 828 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 18318 "parsing/parser.ml" +# 18321 "parsing/parser.ml" in -# 1125 "parsing/parser.mly" +# 1128 "parsing/parser.mly" ( _1 ) -# 18324 "parsing/parser.ml" +# 18327 "parsing/parser.ml" in # 213 "" ( x :: xs ) -# 18330 "parsing/parser.ml" +# 18333 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18365,7 +18368,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = # 124 "" ( None ) -# 18369 "parsing/parser.ml" +# 18372 "parsing/parser.ml" in let x = let label = @@ -18373,9 +18376,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18379 "parsing/parser.ml" +# 18382 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18383,7 +18386,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2765 "parsing/parser.mly" +# 2768 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18394,13 +18397,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18398 "parsing/parser.ml" +# 18401 "parsing/parser.ml" in -# 1052 "parsing/parser.mly" +# 1055 "parsing/parser.mly" ( [x], None ) -# 18404 "parsing/parser.ml" +# 18407 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18446,7 +18449,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = # 126 "" ( Some x ) -# 18450 "parsing/parser.ml" +# 18453 "parsing/parser.ml" in let x = let label = @@ -18454,9 +18457,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18460 "parsing/parser.ml" +# 18463 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18464,7 +18467,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2765 "parsing/parser.mly" +# 2768 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18475,13 +18478,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18479 "parsing/parser.ml" +# 18482 "parsing/parser.ml" in -# 1052 "parsing/parser.mly" +# 1055 "parsing/parser.mly" ( [x], None ) -# 18485 "parsing/parser.ml" +# 18488 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18544,9 +18547,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18550 "parsing/parser.ml" +# 18553 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18554,7 +18557,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2765 "parsing/parser.mly" +# 2768 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18565,13 +18568,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18569 "parsing/parser.ml" +# 18572 "parsing/parser.ml" in -# 1054 "parsing/parser.mly" +# 1057 "parsing/parser.mly" ( [x], Some y ) -# 18575 "parsing/parser.ml" +# 18578 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18627,9 +18630,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18633 "parsing/parser.ml" +# 18636 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18637,7 +18640,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2765 "parsing/parser.mly" +# 2768 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18648,14 +18651,14 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18652 "parsing/parser.ml" +# 18655 "parsing/parser.ml" in -# 1058 "parsing/parser.mly" +# 1061 "parsing/parser.mly" ( let xs, y = tail in x :: xs, y ) -# 18659 "parsing/parser.ml" +# 18662 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18692,9 +18695,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.case) = -# 2523 "parsing/parser.mly" +# 2526 "parsing/parser.mly" ( Exp.case _1 _3 ) -# 18698 "parsing/parser.ml" +# 18701 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18745,9 +18748,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.case) = -# 2525 "parsing/parser.mly" +# 2528 "parsing/parser.mly" ( Exp.case _1 ~guard:_3 _5 ) -# 18751 "parsing/parser.ml" +# 18754 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18785,9 +18788,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2527 "parsing/parser.mly" +# 2530 "parsing/parser.mly" ( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) ) -# 18791 "parsing/parser.ml" +# 18794 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18848,9 +18851,9 @@ module Tables = struct let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 18854 "parsing/parser.ml" +# 18857 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -18859,49 +18862,49 @@ module Tables = struct let _6 = let _1 = _1_inlined3 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 18865 "parsing/parser.ml" +# 18868 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 18874 "parsing/parser.ml" +# 18877 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3179 "parsing/parser.mly" +# 3182 "parsing/parser.mly" ( _1 ) -# 18883 "parsing/parser.ml" +# 18886 "parsing/parser.ml" in let _1 = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 18890 "parsing/parser.ml" +# 18893 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18898 "parsing/parser.ml" +# 18901 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3389 "parsing/parser.mly" +# 3392 "parsing/parser.mly" ( let info = match rhs_info _endpos__4_ with | Some _ as info_before_semi -> info_before_semi @@ -18909,13 +18912,13 @@ module Tables = struct in let attrs = add_info_attrs info (_4 @ _6) in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 18913 "parsing/parser.ml" +# 18916 "parsing/parser.ml" in -# 3370 "parsing/parser.mly" +# 3373 "parsing/parser.mly" ( let (f, c) = tail in (head :: f, c) ) -# 18919 "parsing/parser.ml" +# 18922 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18956,15 +18959,15 @@ module Tables = struct let _symbolstartpos = _startpos_ty_ in let _sloc = (_symbolstartpos, _endpos) in -# 3400 "parsing/parser.mly" +# 3403 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 18962 "parsing/parser.ml" +# 18965 "parsing/parser.ml" in -# 3370 "parsing/parser.mly" +# 3373 "parsing/parser.mly" ( let (f, c) = tail in (head :: f, c) ) -# 18968 "parsing/parser.ml" +# 18971 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19018,9 +19021,9 @@ module Tables = struct let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 19024 "parsing/parser.ml" +# 19027 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -19029,49 +19032,49 @@ module Tables = struct let _6 = let _1 = _1_inlined3 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19035 "parsing/parser.ml" +# 19038 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19044 "parsing/parser.ml" +# 19047 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3179 "parsing/parser.mly" +# 3182 "parsing/parser.mly" ( _1 ) -# 19053 "parsing/parser.ml" +# 19056 "parsing/parser.ml" in let _1 = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19060 "parsing/parser.ml" +# 19063 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19068 "parsing/parser.ml" +# 19071 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3389 "parsing/parser.mly" +# 3392 "parsing/parser.mly" ( let info = match rhs_info _endpos__4_ with | Some _ as info_before_semi -> info_before_semi @@ -19079,13 +19082,13 @@ module Tables = struct in let attrs = add_info_attrs info (_4 @ _6) in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 19083 "parsing/parser.ml" +# 19086 "parsing/parser.ml" in -# 3373 "parsing/parser.mly" +# 3376 "parsing/parser.mly" ( [head], Closed ) -# 19089 "parsing/parser.ml" +# 19092 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19119,15 +19122,15 @@ module Tables = struct let _symbolstartpos = _startpos_ty_ in let _sloc = (_symbolstartpos, _endpos) in -# 3400 "parsing/parser.mly" +# 3403 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 19125 "parsing/parser.ml" +# 19128 "parsing/parser.ml" in -# 3373 "parsing/parser.mly" +# 3376 "parsing/parser.mly" ( [head], Closed ) -# 19131 "parsing/parser.ml" +# 19134 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19167,9 +19170,9 @@ module Tables = struct let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 19173 "parsing/parser.ml" +# 19176 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -19178,50 +19181,50 @@ module Tables = struct let _4 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19184 "parsing/parser.ml" +# 19187 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3179 "parsing/parser.mly" +# 3182 "parsing/parser.mly" ( _1 ) -# 19193 "parsing/parser.ml" +# 19196 "parsing/parser.ml" in let _1 = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19200 "parsing/parser.ml" +# 19203 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19208 "parsing/parser.ml" +# 19211 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3382 "parsing/parser.mly" +# 3385 "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 ) -# 19219 "parsing/parser.ml" +# 19222 "parsing/parser.ml" in -# 3376 "parsing/parser.mly" +# 3379 "parsing/parser.mly" ( [head], Closed ) -# 19225 "parsing/parser.ml" +# 19228 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19248,15 +19251,15 @@ module Tables = struct let _symbolstartpos = _startpos_ty_ in let _sloc = (_symbolstartpos, _endpos) in -# 3400 "parsing/parser.mly" +# 3403 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 19254 "parsing/parser.ml" +# 19257 "parsing/parser.ml" in -# 3376 "parsing/parser.mly" +# 3379 "parsing/parser.mly" ( [head], Closed ) -# 19260 "parsing/parser.ml" +# 19263 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19279,9 +19282,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.object_field list * Asttypes.closed_flag) = -# 3378 "parsing/parser.mly" +# 3381 "parsing/parser.mly" ( [], Open ) -# 19285 "parsing/parser.ml" +# 19288 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19326,9 +19329,9 @@ module Tables = struct 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" +# 650 "parsing/parser.mly" (string) -# 19332 "parsing/parser.ml" +# 19335 "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 @@ -19340,41 +19343,41 @@ module Tables = struct Parsetree.attributes) = let ty = let _1 = _1_inlined2 in -# 3175 "parsing/parser.mly" +# 3178 "parsing/parser.mly" ( _1 ) -# 19346 "parsing/parser.ml" +# 19349 "parsing/parser.ml" in let label = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19354 "parsing/parser.ml" +# 19357 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19362 "parsing/parser.ml" +# 19365 "parsing/parser.ml" in let attrs = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19368 "parsing/parser.ml" +# 19371 "parsing/parser.ml" in let _1 = -# 3641 "parsing/parser.mly" +# 3644 "parsing/parser.mly" ( Fresh ) -# 19373 "parsing/parser.ml" +# 19376 "parsing/parser.ml" in -# 1869 "parsing/parser.mly" +# 1872 "parsing/parser.mly" ( (label, private_, Cfk_virtual ty), attrs ) -# 19378 "parsing/parser.ml" +# 19381 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19412,9 +19415,9 @@ module Tables = struct } = _menhir_stack in let _5 : (Parsetree.expression) = Obj.magic _5 in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 19418 "parsing/parser.ml" +# 19421 "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 @@ -19426,36 +19429,36 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19432 "parsing/parser.ml" +# 19435 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19440 "parsing/parser.ml" +# 19443 "parsing/parser.ml" in let _2 = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19446 "parsing/parser.ml" +# 19449 "parsing/parser.ml" in let _1 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 19451 "parsing/parser.ml" +# 19454 "parsing/parser.ml" in -# 1871 "parsing/parser.mly" +# 1874 "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 ) -# 19459 "parsing/parser.ml" +# 19462 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19499,9 +19502,9 @@ module Tables = struct } = _menhir_stack in let _5 : (Parsetree.expression) = Obj.magic _5 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 19505 "parsing/parser.ml" +# 19508 "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 @@ -19514,39 +19517,39 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19520 "parsing/parser.ml" +# 19523 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19528 "parsing/parser.ml" +# 19531 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19536 "parsing/parser.ml" +# 19539 "parsing/parser.ml" in let _1 = -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 19542 "parsing/parser.ml" +# 19545 "parsing/parser.ml" in -# 1871 "parsing/parser.mly" +# 1874 "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 ) -# 19550 "parsing/parser.ml" +# 19553 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19605,9 +19608,9 @@ module Tables = struct 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" +# 650 "parsing/parser.mly" (string) -# 19611 "parsing/parser.ml" +# 19614 "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 @@ -19619,45 +19622,45 @@ module Tables = struct Parsetree.attributes) = let _6 = let _1 = _1_inlined2 in -# 3175 "parsing/parser.mly" +# 3178 "parsing/parser.mly" ( _1 ) -# 19625 "parsing/parser.ml" +# 19628 "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 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19634 "parsing/parser.ml" +# 19637 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19642 "parsing/parser.ml" +# 19645 "parsing/parser.ml" in let _2 = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19648 "parsing/parser.ml" +# 19651 "parsing/parser.ml" in let _1 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 19653 "parsing/parser.ml" +# 19656 "parsing/parser.ml" in -# 1877 "parsing/parser.mly" +# 1880 "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 ) -# 19661 "parsing/parser.ml" +# 19664 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19722,9 +19725,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 19728 "parsing/parser.ml" +# 19731 "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 @@ -19737,48 +19740,48 @@ module Tables = struct Parsetree.attributes) = let _6 = let _1 = _1_inlined3 in -# 3175 "parsing/parser.mly" +# 3178 "parsing/parser.mly" ( _1 ) -# 19743 "parsing/parser.ml" +# 19746 "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 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19752 "parsing/parser.ml" +# 19755 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19760 "parsing/parser.ml" +# 19763 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19768 "parsing/parser.ml" +# 19771 "parsing/parser.ml" in let _1 = -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 19774 "parsing/parser.ml" +# 19777 "parsing/parser.ml" in -# 1877 "parsing/parser.mly" +# 1880 "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 ) -# 19782 "parsing/parser.ml" +# 19785 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19858,9 +19861,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 19864 "parsing/parser.ml" +# 19867 "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 @@ -19870,38 +19873,38 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag * Parsetree.class_field_kind) * Parsetree.attributes) = let _7 = -# 2414 "parsing/parser.mly" +# 2417 "parsing/parser.mly" ( xs ) -# 19876 "parsing/parser.ml" +# 19879 "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 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 19884 "parsing/parser.ml" +# 19887 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19892 "parsing/parser.ml" +# 19895 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined1_ in let _2 = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 19899 "parsing/parser.ml" +# 19902 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in let _1 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 19905 "parsing/parser.ml" +# 19908 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in let _endpos = _endpos__11_ in @@ -19917,7 +19920,7 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1883 "parsing/parser.mly" +# 1886 "parsing/parser.mly" ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in let poly_exp = let exp, poly = @@ -19928,7 +19931,7 @@ module Tables = struct ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 19932 "parsing/parser.ml" +# 19935 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20014,9 +20017,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 20020 "parsing/parser.ml" +# 20023 "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 @@ -20027,41 +20030,41 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag * Parsetree.class_field_kind) * Parsetree.attributes) = let _7 = -# 2414 "parsing/parser.mly" +# 2417 "parsing/parser.mly" ( xs ) -# 20033 "parsing/parser.ml" +# 20036 "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 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 20041 "parsing/parser.ml" +# 20044 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 20049 "parsing/parser.ml" +# 20052 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 20058 "parsing/parser.ml" +# 20061 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in let _1 = -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 20065 "parsing/parser.ml" +# 20068 "parsing/parser.ml" in let _endpos = _endpos__11_ in let _symbolstartpos = if _startpos__1_ != _endpos__1_ then @@ -20076,7 +20079,7 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1883 "parsing/parser.mly" +# 1886 "parsing/parser.mly" ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in let poly_exp = let exp, poly = @@ -20087,7 +20090,7 @@ module Tables = struct ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 20091 "parsing/parser.ml" +# 20094 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20106,17 +20109,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 20112 "parsing/parser.ml" +# 20115 "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) = -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20120 "parsing/parser.ml" +# 20123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20147,9 +20150,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 20153 "parsing/parser.ml" +# 20156 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -20157,9 +20160,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20163 "parsing/parser.ml" +# 20166 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20178,17 +20181,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 20184 "parsing/parser.ml" +# 20187 "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) = -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20192 "parsing/parser.ml" +# 20195 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20219,9 +20222,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 20225 "parsing/parser.ml" +# 20228 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -20229,9 +20232,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20235 "parsing/parser.ml" +# 20238 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20254,14 +20257,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = let _1 = -# 3538 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( _1 ) -# 20260 "parsing/parser.ml" +# 20263 "parsing/parser.ml" in -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20265 "parsing/parser.ml" +# 20268 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20299,20 +20302,20 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Longident.t) = let _1 = let _1 = -# 3481 "parsing/parser.mly" +# 3484 "parsing/parser.mly" ( "::" ) -# 20305 "parsing/parser.ml" +# 20308 "parsing/parser.ml" in -# 3538 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( _1 ) -# 20310 "parsing/parser.ml" +# 20313 "parsing/parser.ml" in -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20316 "parsing/parser.ml" +# 20319 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20335,14 +20338,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = let _1 = -# 3538 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( _1 ) -# 20341 "parsing/parser.ml" +# 20344 "parsing/parser.ml" in -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20346 "parsing/parser.ml" +# 20349 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20381,15 +20384,15 @@ module Tables = struct let _v : (Longident.t) = let _3 = let _1 = _1_inlined1 in -# 3538 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( _1 ) -# 20387 "parsing/parser.ml" +# 20390 "parsing/parser.ml" in -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20393 "parsing/parser.ml" +# 20396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20442,20 +20445,20 @@ module Tables = struct let _v : (Longident.t) = let _3 = let (_2, _1) = (_2_inlined1, _1_inlined1) in let _1 = -# 3481 "parsing/parser.mly" +# 3484 "parsing/parser.mly" ( "::" ) -# 20448 "parsing/parser.ml" +# 20451 "parsing/parser.ml" in -# 3538 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( _1 ) -# 20453 "parsing/parser.ml" +# 20456 "parsing/parser.ml" in -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20459 "parsing/parser.ml" +# 20462 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20494,15 +20497,15 @@ module Tables = struct let _v : (Longident.t) = let _3 = let _1 = _1_inlined1 in -# 3538 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( _1 ) -# 20500 "parsing/parser.ml" +# 20503 "parsing/parser.ml" in -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20506 "parsing/parser.ml" +# 20509 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20525,9 +20528,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20531 "parsing/parser.ml" +# 20534 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20564,9 +20567,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20570 "parsing/parser.ml" +# 20573 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20585,17 +20588,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 20591 "parsing/parser.ml" +# 20594 "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) = -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20599 "parsing/parser.ml" +# 20602 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20626,9 +20629,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 20632 "parsing/parser.ml" +# 20635 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -20636,9 +20639,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20642 "parsing/parser.ml" +# 20645 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20657,17 +20660,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 20663 "parsing/parser.ml" +# 20666 "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) = -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20671 "parsing/parser.ml" +# 20674 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20698,9 +20701,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 20704 "parsing/parser.ml" +# 20707 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -20708,9 +20711,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20714 "parsing/parser.ml" +# 20717 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20733,9 +20736,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3501 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Lident _1 ) -# 20739 "parsing/parser.ml" +# 20742 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20772,9 +20775,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3502 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Ldot(_1,_3) ) -# 20778 "parsing/parser.ml" +# 20781 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20797,9 +20800,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3517 "parsing/parser.mly" +# 3520 "parsing/parser.mly" ( _1 ) -# 20803 "parsing/parser.ml" +# 20806 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20846,9 +20849,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3519 "parsing/parser.mly" +# 3522 "parsing/parser.mly" ( lapply ~loc:_sloc _1 _3 ) -# 20852 "parsing/parser.ml" +# 20855 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20886,9 +20889,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 3521 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( expecting _loc__3_ "module path" ) -# 20892 "parsing/parser.ml" +# 20895 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20911,9 +20914,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3514 "parsing/parser.mly" +# 3517 "parsing/parser.mly" ( _1 ) -# 20917 "parsing/parser.ml" +# 20920 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20943,9 +20946,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_me_ in let _v : (Parsetree.module_expr) = -# 1373 "parsing/parser.mly" +# 1376 "parsing/parser.mly" ( me ) -# 20949 "parsing/parser.ml" +# 20952 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20990,24 +20993,24 @@ module Tables = struct let _endpos = _endpos_me_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1376 "parsing/parser.mly" +# 1379 "parsing/parser.mly" ( Pmod_constraint(me, mty) ) -# 20996 "parsing/parser.ml" +# 20999 "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" +# 859 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21005 "parsing/parser.ml" +# 21008 "parsing/parser.ml" in -# 1379 "parsing/parser.mly" +# 1382 "parsing/parser.mly" ( _1 ) -# 21011 "parsing/parser.ml" +# 21014 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21038,24 +21041,24 @@ module Tables = struct let _endpos = _endpos_body_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1378 "parsing/parser.mly" +# 1381 "parsing/parser.mly" ( Pmod_functor(arg, body) ) -# 21044 "parsing/parser.ml" +# 21047 "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" +# 859 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21053 "parsing/parser.ml" +# 21056 "parsing/parser.ml" in -# 1379 "parsing/parser.mly" +# 1382 "parsing/parser.mly" ( _1 ) -# 21059 "parsing/parser.ml" +# 21062 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21085,9 +21088,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_mty_ in let _v : (Parsetree.module_type) = -# 1616 "parsing/parser.mly" +# 1619 "parsing/parser.mly" ( mty ) -# 21091 "parsing/parser.ml" +# 21094 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21118,24 +21121,24 @@ module Tables = struct let _endpos = _endpos_body_ in let _v : (Parsetree.module_type) = let _1 = let _1 = -# 1619 "parsing/parser.mly" +# 1622 "parsing/parser.mly" ( Pmty_functor(arg, body) ) -# 21124 "parsing/parser.ml" +# 21127 "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" +# 861 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 21133 "parsing/parser.ml" +# 21136 "parsing/parser.ml" in -# 1621 "parsing/parser.mly" +# 1624 "parsing/parser.mly" ( _1 ) -# 21139 "parsing/parser.ml" +# 21142 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21181,18 +21184,18 @@ module Tables = struct let _v : (Parsetree.module_expr) = let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21187 "parsing/parser.ml" +# 21190 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1212 "parsing/parser.mly" +# 1215 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_structure s) ) -# 21196 "parsing/parser.ml" +# 21199 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21238,17 +21241,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21244 "parsing/parser.ml" +# 21247 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1214 "parsing/parser.mly" +# 1217 "parsing/parser.mly" ( unclosed "struct" _loc__1_ "end" _loc__4_ ) -# 21252 "parsing/parser.ml" +# 21255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21301,30 +21304,30 @@ module Tables = struct let _v : (Parsetree.module_expr) = let args = let _1 = _1_inlined2 in -# 1178 "parsing/parser.mly" +# 1181 "parsing/parser.mly" ( _1 ) -# 21307 "parsing/parser.ml" +# 21310 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21315 "parsing/parser.ml" +# 21318 "parsing/parser.ml" in let _endpos = _endpos_me_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1216 "parsing/parser.mly" +# 1219 "parsing/parser.mly" ( wrap_mod_attrs ~loc:_sloc attrs ( List.fold_left (fun acc arg -> mkmod ~loc:_sloc (Pmod_functor (arg, acc)) ) me args ) ) -# 21328 "parsing/parser.ml" +# 21331 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21347,9 +21350,9 @@ module Tables = struct let _startpos = _startpos_me_ in let _endpos = _endpos_me_ in let _v : (Parsetree.module_expr) = -# 1222 "parsing/parser.mly" +# 1225 "parsing/parser.mly" ( me ) -# 21353 "parsing/parser.ml" +# 21356 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21379,9 +21382,9 @@ module Tables = struct let _startpos = _startpos_me_ in let _endpos = _endpos_attr_ in let _v : (Parsetree.module_expr) = -# 1224 "parsing/parser.mly" +# 1227 "parsing/parser.mly" ( Mod.attr me attr ) -# 21385 "parsing/parser.ml" +# 21388 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21410,30 +21413,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21416 "parsing/parser.ml" +# 21419 "parsing/parser.ml" in -# 1228 "parsing/parser.mly" +# 1231 "parsing/parser.mly" ( Pmod_ident x ) -# 21422 "parsing/parser.ml" +# 21425 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 856 "parsing/parser.mly" +# 859 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21431 "parsing/parser.ml" +# 21434 "parsing/parser.ml" in -# 1240 "parsing/parser.mly" +# 1243 "parsing/parser.mly" ( _1 ) -# 21437 "parsing/parser.ml" +# 21440 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21464,24 +21467,24 @@ module Tables = struct let _endpos = _endpos_me2_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1231 "parsing/parser.mly" +# 1234 "parsing/parser.mly" ( Pmod_apply(me1, me2) ) -# 21470 "parsing/parser.ml" +# 21473 "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" +# 859 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21479 "parsing/parser.ml" +# 21482 "parsing/parser.ml" in -# 1240 "parsing/parser.mly" +# 1243 "parsing/parser.mly" ( _1 ) -# 21485 "parsing/parser.ml" +# 21488 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21523,10 +21526,10 @@ module Tables = struct let _symbolstartpos = _startpos_me1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1234 "parsing/parser.mly" +# 1237 "parsing/parser.mly" ( (* TODO review mkmod location *) Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) ) -# 21530 "parsing/parser.ml" +# 21533 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in @@ -21534,15 +21537,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 856 "parsing/parser.mly" +# 859 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21540 "parsing/parser.ml" +# 21543 "parsing/parser.ml" in -# 1240 "parsing/parser.mly" +# 1243 "parsing/parser.mly" ( _1 ) -# 21546 "parsing/parser.ml" +# 21549 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21566,24 +21569,24 @@ module Tables = struct let _endpos = _endpos_ex_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1238 "parsing/parser.mly" +# 1241 "parsing/parser.mly" ( Pmod_extension ex ) -# 21572 "parsing/parser.ml" +# 21575 "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" +# 859 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21581 "parsing/parser.ml" +# 21584 "parsing/parser.ml" in -# 1240 "parsing/parser.mly" +# 1243 "parsing/parser.mly" ( _1 ) -# 21587 "parsing/parser.ml" +# 21590 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21602,17 +21605,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let x : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 21608 "parsing/parser.ml" +# 21611 "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" +# 1198 "parsing/parser.mly" ( Some x ) -# 21616 "parsing/parser.ml" +# 21619 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21635,9 +21638,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string option) = -# 1198 "parsing/parser.mly" +# 1201 "parsing/parser.mly" ( None ) -# 21641 "parsing/parser.ml" +# 21644 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21695,9 +21698,9 @@ module Tables = struct let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 21701 "parsing/parser.ml" +# 21704 "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 @@ -21708,9 +21711,9 @@ module Tables = struct let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 21714 "parsing/parser.ml" +# 21717 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -21720,9 +21723,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21726 "parsing/parser.ml" +# 21729 "parsing/parser.ml" in let uid = @@ -21731,31 +21734,31 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21737 "parsing/parser.ml" +# 21740 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21745 "parsing/parser.ml" +# 21748 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1651 "parsing/parser.mly" +# 1654 "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 ) -# 21759 "parsing/parser.ml" +# 21762 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21806,9 +21809,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 697 "parsing/parser.mly" +# 700 "parsing/parser.mly" (string) -# 21812 "parsing/parser.ml" +# 21815 "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 @@ -21822,24 +21825,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21828 "parsing/parser.ml" +# 21831 "parsing/parser.ml" in let _3 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21836 "parsing/parser.ml" +# 21839 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in -# 1658 "parsing/parser.mly" +# 1661 "parsing/parser.mly" ( expecting _loc__6_ "module path" ) -# 21843 "parsing/parser.ml" +# 21846 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21885,18 +21888,18 @@ module Tables = struct let _v : (Parsetree.module_type) = let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21891 "parsing/parser.ml" +# 21894 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1504 "parsing/parser.mly" +# 1507 "parsing/parser.mly" ( mkmty ~loc:_sloc ~attrs (Pmty_signature s) ) -# 21900 "parsing/parser.ml" +# 21903 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21942,17 +21945,17 @@ module Tables = struct let _v : (Parsetree.module_type) = let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 21948 "parsing/parser.ml" +# 21951 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1506 "parsing/parser.mly" +# 1509 "parsing/parser.mly" ( unclosed "sig" _loc__1_ "end" _loc__4_ ) -# 21956 "parsing/parser.ml" +# 21959 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22005,30 +22008,30 @@ module Tables = struct let _v : (Parsetree.module_type) = let args = let _1 = _1_inlined2 in -# 1178 "parsing/parser.mly" +# 1181 "parsing/parser.mly" ( _1 ) -# 22011 "parsing/parser.ml" +# 22014 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 22019 "parsing/parser.ml" +# 22022 "parsing/parser.ml" in let _endpos = _endpos_mty_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1510 "parsing/parser.mly" +# 1513 "parsing/parser.mly" ( wrap_mty_attrs ~loc:_sloc attrs ( List.fold_left (fun acc arg -> mkmty ~loc:_sloc (Pmty_functor (arg, acc)) ) mty args ) ) -# 22032 "parsing/parser.ml" +# 22035 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22081,18 +22084,18 @@ module Tables = struct let _v : (Parsetree.module_type) = let _4 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 22087 "parsing/parser.ml" +# 22090 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1516 "parsing/parser.mly" +# 1519 "parsing/parser.mly" ( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) ) -# 22096 "parsing/parser.ml" +# 22099 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22129,9 +22132,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.module_type) = -# 1518 "parsing/parser.mly" +# 1521 "parsing/parser.mly" ( _2 ) -# 22135 "parsing/parser.ml" +# 22138 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22170,9 +22173,9 @@ module Tables = struct 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" +# 1523 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 22176 "parsing/parser.ml" +# 22179 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22202,9 +22205,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.module_type) = -# 1522 "parsing/parser.mly" +# 1525 "parsing/parser.mly" ( Mty.attr _1 _2 ) -# 22208 "parsing/parser.ml" +# 22211 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22233,30 +22236,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22239 "parsing/parser.ml" +# 22242 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1528 "parsing/parser.mly" ( Pmty_ident _1 ) -# 22245 "parsing/parser.ml" +# 22248 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 858 "parsing/parser.mly" +# 861 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 22254 "parsing/parser.ml" +# 22257 "parsing/parser.ml" in -# 1536 "parsing/parser.mly" +# 1539 "parsing/parser.mly" ( _1 ) -# 22260 "parsing/parser.ml" +# 22263 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22294,24 +22297,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.module_type) = let _1 = let _1 = -# 1528 "parsing/parser.mly" +# 1531 "parsing/parser.mly" ( Pmty_functor(Named (mknoloc None, _1), _3) ) -# 22300 "parsing/parser.ml" +# 22303 "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" +# 861 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 22309 "parsing/parser.ml" +# 22312 "parsing/parser.ml" in -# 1536 "parsing/parser.mly" +# 1539 "parsing/parser.mly" ( _1 ) -# 22315 "parsing/parser.ml" +# 22318 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22353,18 +22356,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 22357 "parsing/parser.ml" +# 22360 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 22362 "parsing/parser.ml" +# 22365 "parsing/parser.ml" in -# 1530 "parsing/parser.mly" +# 1533 "parsing/parser.mly" ( Pmty_with(_1, _3) ) -# 22368 "parsing/parser.ml" +# 22371 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -22372,15 +22375,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 858 "parsing/parser.mly" +# 861 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 22378 "parsing/parser.ml" +# 22381 "parsing/parser.ml" in -# 1536 "parsing/parser.mly" +# 1539 "parsing/parser.mly" ( _1 ) -# 22384 "parsing/parser.ml" +# 22387 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22404,23 +22407,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.module_type) = let _1 = let _1 = -# 1534 "parsing/parser.mly" +# 1537 "parsing/parser.mly" ( Pmty_extension _1 ) -# 22410 "parsing/parser.ml" +# 22413 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 858 "parsing/parser.mly" +# 861 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 22418 "parsing/parser.ml" +# 22421 "parsing/parser.ml" in -# 1536 "parsing/parser.mly" +# 1539 "parsing/parser.mly" ( _1 ) -# 22424 "parsing/parser.ml" +# 22427 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22487,9 +22490,9 @@ module Tables = struct let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 22493 "parsing/parser.ml" +# 22496 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -22499,31 +22502,31 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22505 "parsing/parser.ml" +# 22508 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 22513 "parsing/parser.ml" +# 22516 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1450 "parsing/parser.mly" +# 1453 "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 ) -# 22527 "parsing/parser.ml" +# 22530 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22546,9 +22549,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3524 "parsing/parser.mly" +# 3527 "parsing/parser.mly" ( _1 ) -# 22552 "parsing/parser.ml" +# 22555 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22564,9 +22567,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.mutable_flag) = -# 3601 "parsing/parser.mly" +# 3604 "parsing/parser.mly" ( Immutable ) -# 22570 "parsing/parser.ml" +# 22573 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22589,9 +22592,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag) = -# 3602 "parsing/parser.mly" +# 3605 "parsing/parser.mly" ( Mutable ) -# 22595 "parsing/parser.ml" +# 22598 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22607,9 +22610,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3610 "parsing/parser.mly" +# 3613 "parsing/parser.mly" ( Immutable, Concrete ) -# 22613 "parsing/parser.ml" +# 22616 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22632,9 +22635,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3612 "parsing/parser.mly" +# 3615 "parsing/parser.mly" ( Mutable, Concrete ) -# 22638 "parsing/parser.ml" +# 22641 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22657,9 +22660,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3614 "parsing/parser.mly" +# 3617 "parsing/parser.mly" ( Immutable, Virtual ) -# 22663 "parsing/parser.ml" +# 22666 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22689,9 +22692,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3617 "parsing/parser.mly" +# 3620 "parsing/parser.mly" ( Mutable, Virtual ) -# 22695 "parsing/parser.ml" +# 22698 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22721,9 +22724,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3617 "parsing/parser.mly" +# 3620 "parsing/parser.mly" ( Mutable, Virtual ) -# 22727 "parsing/parser.ml" +# 22730 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22753,9 +22756,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.label) = -# 3574 "parsing/parser.mly" +# 3577 "parsing/parser.mly" ( _2 ) -# 22759 "parsing/parser.ml" +# 22762 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22774,9 +22777,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 22780 "parsing/parser.ml" +# 22783 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22786,15 +22789,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22792 "parsing/parser.ml" +# 22795 "parsing/parser.ml" in # 221 "" ( [ x ] ) -# 22798 "parsing/parser.ml" +# 22801 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22820,9 +22823,9 @@ module Tables = struct } = _menhir_stack in let xs : (string Asttypes.loc list) = Obj.magic xs in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 22826 "parsing/parser.ml" +# 22829 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22832,15 +22835,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22838 "parsing/parser.ml" +# 22841 "parsing/parser.ml" in # 223 "" ( x :: xs ) -# 22844 "parsing/parser.ml" +# 22847 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22859,22 +22862,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let s : ( -# 685 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string * Location.t * string option) -# 22865 "parsing/parser.ml" +# 22868 "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 = -# 3570 "parsing/parser.mly" +# 3573 "parsing/parser.mly" ( let body, _, _ = s in body ) -# 22873 "parsing/parser.ml" +# 22876 "parsing/parser.ml" in # 221 "" ( [ x ] ) -# 22878 "parsing/parser.ml" +# 22881 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22900,22 +22903,22 @@ module Tables = struct } = _menhir_stack in let xs : (string list) = Obj.magic xs in let s : ( -# 685 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string * Location.t * string option) -# 22906 "parsing/parser.ml" +# 22909 "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 = -# 3570 "parsing/parser.mly" +# 3573 "parsing/parser.mly" ( let body, _, _ = s in body ) -# 22914 "parsing/parser.ml" +# 22917 "parsing/parser.ml" in # 223 "" ( x :: xs ) -# 22919 "parsing/parser.ml" +# 22922 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22938,14 +22941,14 @@ module Tables = struct let _startpos = _startpos_ty_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 22944 "parsing/parser.ml" +# 22947 "parsing/parser.ml" in -# 2896 "parsing/parser.mly" +# 2899 "parsing/parser.mly" ( (Ptype_abstract, priv, Some ty) ) -# 22949 "parsing/parser.ml" +# 22952 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22975,14 +22978,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 22981 "parsing/parser.ml" +# 22984 "parsing/parser.ml" in -# 2896 "parsing/parser.mly" +# 2899 "parsing/parser.mly" ( (Ptype_abstract, priv, Some ty) ) -# 22986 "parsing/parser.ml" +# 22989 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23005,26 +23008,26 @@ module Tables = struct let _startpos = _startpos_cs_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 23011 "parsing/parser.ml" +# 23014 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 23017 "parsing/parser.ml" +# 23020 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23022 "parsing/parser.ml" +# 23025 "parsing/parser.ml" in -# 2900 "parsing/parser.mly" +# 2903 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 23028 "parsing/parser.ml" +# 23031 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23054,26 +23057,26 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 23060 "parsing/parser.ml" +# 23063 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 23066 "parsing/parser.ml" +# 23069 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23071 "parsing/parser.ml" +# 23074 "parsing/parser.ml" in -# 2900 "parsing/parser.mly" +# 2903 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 23077 "parsing/parser.ml" +# 23080 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23110,33 +23113,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 23116 "parsing/parser.ml" +# 23119 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 23123 "parsing/parser.ml" +# 23126 "parsing/parser.ml" in # 126 "" ( Some x ) -# 23128 "parsing/parser.ml" +# 23131 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23134 "parsing/parser.ml" +# 23137 "parsing/parser.ml" in -# 2900 "parsing/parser.mly" +# 2903 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 23140 "parsing/parser.ml" +# 23143 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23180,33 +23183,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 23186 "parsing/parser.ml" +# 23189 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 23193 "parsing/parser.ml" +# 23196 "parsing/parser.ml" in # 126 "" ( Some x ) -# 23198 "parsing/parser.ml" +# 23201 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23204 "parsing/parser.ml" +# 23207 "parsing/parser.ml" in -# 2900 "parsing/parser.mly" +# 2903 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 23210 "parsing/parser.ml" +# 23213 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23229,26 +23232,26 @@ module Tables = struct let _startpos = _startpos__3_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 23235 "parsing/parser.ml" +# 23238 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 23241 "parsing/parser.ml" +# 23244 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23246 "parsing/parser.ml" +# 23249 "parsing/parser.ml" in -# 2904 "parsing/parser.mly" +# 2907 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 23252 "parsing/parser.ml" +# 23255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23278,26 +23281,26 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 23284 "parsing/parser.ml" +# 23287 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 23290 "parsing/parser.ml" +# 23293 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23295 "parsing/parser.ml" +# 23298 "parsing/parser.ml" in -# 2904 "parsing/parser.mly" +# 2907 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 23301 "parsing/parser.ml" +# 23304 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23334,33 +23337,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 23340 "parsing/parser.ml" +# 23343 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 23347 "parsing/parser.ml" +# 23350 "parsing/parser.ml" in # 126 "" ( Some x ) -# 23352 "parsing/parser.ml" +# 23355 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23358 "parsing/parser.ml" +# 23361 "parsing/parser.ml" in -# 2904 "parsing/parser.mly" +# 2907 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 23364 "parsing/parser.ml" +# 23367 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23404,33 +23407,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 23410 "parsing/parser.ml" +# 23413 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 23417 "parsing/parser.ml" +# 23420 "parsing/parser.ml" in # 126 "" ( Some x ) -# 23422 "parsing/parser.ml" +# 23425 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23428 "parsing/parser.ml" +# 23431 "parsing/parser.ml" in -# 2904 "parsing/parser.mly" +# 2907 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 23434 "parsing/parser.ml" +# 23437 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23467,26 +23470,26 @@ module Tables = struct let _startpos = _startpos__3_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 23473 "parsing/parser.ml" +# 23476 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 23479 "parsing/parser.ml" +# 23482 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23484 "parsing/parser.ml" +# 23487 "parsing/parser.ml" in -# 2908 "parsing/parser.mly" +# 2911 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 23490 "parsing/parser.ml" +# 23493 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23530,26 +23533,26 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 23536 "parsing/parser.ml" +# 23539 "parsing/parser.ml" in let oty = let _1 = # 124 "" ( None ) -# 23542 "parsing/parser.ml" +# 23545 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23547 "parsing/parser.ml" +# 23550 "parsing/parser.ml" in -# 2908 "parsing/parser.mly" +# 2911 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 23553 "parsing/parser.ml" +# 23556 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23600,33 +23603,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 23606 "parsing/parser.ml" +# 23609 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 23613 "parsing/parser.ml" +# 23616 "parsing/parser.ml" in # 126 "" ( Some x ) -# 23618 "parsing/parser.ml" +# 23621 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23624 "parsing/parser.ml" +# 23627 "parsing/parser.ml" in -# 2908 "parsing/parser.mly" +# 2911 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 23630 "parsing/parser.ml" +# 23633 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23684,33 +23687,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 23690 "parsing/parser.ml" +# 23693 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "" ( x ) -# 23697 "parsing/parser.ml" +# 23700 "parsing/parser.ml" in # 126 "" ( Some x ) -# 23702 "parsing/parser.ml" +# 23705 "parsing/parser.ml" in -# 2912 "parsing/parser.mly" +# 2915 "parsing/parser.mly" ( _1 ) -# 23708 "parsing/parser.ml" +# 23711 "parsing/parser.ml" in -# 2908 "parsing/parser.mly" +# 2911 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 23714 "parsing/parser.ml" +# 23717 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23763,37 +23766,37 @@ module Tables = struct let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 23769 "parsing/parser.ml" +# 23772 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 23778 "parsing/parser.ml" +# 23781 "parsing/parser.ml" in let override = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 23784 "parsing/parser.ml" +# 23787 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1469 "parsing/parser.mly" +# 1472 "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 ) -# 23797 "parsing/parser.ml" +# 23800 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23853,40 +23856,40 @@ module Tables = struct let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 23859 "parsing/parser.ml" +# 23862 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let attrs1 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 23868 "parsing/parser.ml" +# 23871 "parsing/parser.ml" in let override = let _1 = _1_inlined1 in -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 23876 "parsing/parser.ml" +# 23879 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1469 "parsing/parser.mly" +# 1472 "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 ) -# 23890 "parsing/parser.ml" +# 23893 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23939,9 +23942,9 @@ module Tables = struct let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 23945 "parsing/parser.ml" +# 23948 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -23951,36 +23954,36 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 23957 "parsing/parser.ml" +# 23960 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 23965 "parsing/parser.ml" +# 23968 "parsing/parser.ml" in let override = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 23971 "parsing/parser.ml" +# 23974 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1484 "parsing/parser.mly" +# 1487 "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 ) -# 23984 "parsing/parser.ml" +# 23987 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24040,9 +24043,9 @@ module Tables = struct let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 24046 "parsing/parser.ml" +# 24049 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -24052,39 +24055,39 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24058 "parsing/parser.ml" +# 24061 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined2 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 24066 "parsing/parser.ml" +# 24069 "parsing/parser.ml" in let override = let _1 = _1_inlined1 in -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 24074 "parsing/parser.ml" +# 24077 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1484 "parsing/parser.mly" +# 1487 "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 ) -# 24088 "parsing/parser.ml" +# 24091 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24103,396 +24106,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 671 "parsing/parser.mly" +# 674 "parsing/parser.mly" (string) -# 24109 "parsing/parser.ml" +# 24112 "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) = -# 3440 "parsing/parser.mly" - ( _1 ) -# 24117 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 24138 "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) = -# 3441 "parsing/parser.mly" - ( _1 ) -# 24146 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 24167 "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) = -# 3442 "parsing/parser.mly" - ( _1 ) -# 24175 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 24217 "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) = # 3443 "parsing/parser.mly" - ( "."^ _1 ^"(" ^ _3 ^ ")" ) -# 24225 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 24274 "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) = -# 3444 "parsing/parser.mly" - ( "."^ _1 ^ "(" ^ _3 ^ ")<-" ) -# 24282 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 24324 "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) = -# 3445 "parsing/parser.mly" - ( "."^ _1 ^"[" ^ _3 ^ "]" ) -# 24332 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 24381 "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) = -# 3446 "parsing/parser.mly" - ( "."^ _1 ^ "[" ^ _3 ^ "]<-" ) -# 24389 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 24431 "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) = -# 3447 "parsing/parser.mly" - ( "."^ _1 ^"{" ^ _3 ^ "}" ) -# 24439 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 24488 "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) = -# 3448 "parsing/parser.mly" - ( "."^ _1 ^ "{" ^ _3 ^ "}<-" ) -# 24496 "parsing/parser.ml" + ( _1 ) +# 24120 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24511,17 +24135,396 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 682 "parsing/parser.mly" +# 632 "parsing/parser.mly" (string) -# 24517 "parsing/parser.ml" +# 24141 "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) = -# 3449 "parsing/parser.mly" +# 3444 "parsing/parser.mly" ( _1 ) -# 24525 "parsing/parser.ml" +# 24149 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) +# 24170 "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) = +# 3445 "parsing/parser.mly" + ( _1 ) +# 24178 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 24220 "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) = +# 3446 "parsing/parser.mly" + ( "."^ _1 ^"(" ^ _3 ^ ")" ) +# 24228 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 24277 "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) = +# 3447 "parsing/parser.mly" + ( "."^ _1 ^ "(" ^ _3 ^ ")<-" ) +# 24285 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 24327 "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) = +# 3448 "parsing/parser.mly" + ( "."^ _1 ^"[" ^ _3 ^ "]" ) +# 24335 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 24384 "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) = +# 3449 "parsing/parser.mly" + ( "."^ _1 ^ "[" ^ _3 ^ "]<-" ) +# 24392 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 24434 "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) = +# 3450 "parsing/parser.mly" + ( "."^ _1 ^"{" ^ _3 ^ "}" ) +# 24442 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 24491 "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) = +# 3451 "parsing/parser.mly" + ( "."^ _1 ^ "{" ^ _3 ^ "}<-" ) +# 24499 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) +# 24520 "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) = +# 3452 "parsing/parser.mly" + ( _1 ) +# 24528 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24544,111 +24547,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.label) = -# 3450 "parsing/parser.mly" +# 3453 "parsing/parser.mly" ( "!" ) -# 24550 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 24571 "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 = -# 3454 "parsing/parser.mly" - ( op ) -# 24579 "parsing/parser.ml" - in - -# 3451 "parsing/parser.mly" - ( _1 ) -# 24584 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 24605 "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 = -# 3455 "parsing/parser.mly" - ( op ) -# 24613 "parsing/parser.ml" - in - -# 3451 "parsing/parser.mly" - ( _1 ) -# 24618 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 24639 "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 = -# 3456 "parsing/parser.mly" - ( op ) -# 24647 "parsing/parser.ml" - in - -# 3451 "parsing/parser.mly" - ( _1 ) -# 24652 "parsing/parser.ml" +# 24553 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24669,7 +24570,7 @@ module Tables = struct let op : ( # 626 "parsing/parser.mly" (string) -# 24673 "parsing/parser.ml" +# 24574 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -24677,12 +24578,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3457 "parsing/parser.mly" ( op ) -# 24681 "parsing/parser.ml" +# 24582 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24686 "parsing/parser.ml" +# 24587 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24703,7 +24604,7 @@ module Tables = struct let op : ( # 627 "parsing/parser.mly" (string) -# 24707 "parsing/parser.ml" +# 24608 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in @@ -24711,12 +24612,12 @@ module Tables = struct let _v : (Asttypes.label) = let _1 = # 3458 "parsing/parser.mly" ( op ) -# 24715 "parsing/parser.ml" +# 24616 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24720 "parsing/parser.ml" +# 24621 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24729,24 +24630,28 @@ module Tables = struct 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.semv = op; + MenhirLib.EngineTypes.startp = _startpos_op_; + MenhirLib.EngineTypes.endp = _endpos_op_; MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in - let _1 : unit = Obj.magic _1 in + let op : ( +# 628 "parsing/parser.mly" + (string) +# 24642 "parsing/parser.ml" + ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in - let _startpos = _startpos__1_ in - let _endpos = _endpos__1_ in + let _startpos = _startpos_op_ in + let _endpos = _endpos_op_ in let _v : (Asttypes.label) = let _1 = # 3459 "parsing/parser.mly" - ("+") -# 24745 "parsing/parser.ml" + ( op ) +# 24650 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24750 "parsing/parser.ml" +# 24655 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24759,24 +24664,28 @@ module Tables = struct 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.semv = op; + MenhirLib.EngineTypes.startp = _startpos_op_; + MenhirLib.EngineTypes.endp = _endpos_op_; MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in - let _1 : unit = Obj.magic _1 in + let op : ( +# 629 "parsing/parser.mly" + (string) +# 24676 "parsing/parser.ml" + ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in - let _startpos = _startpos__1_ in - let _endpos = _endpos__1_ in + let _startpos = _startpos_op_ in + let _endpos = _endpos_op_ in let _v : (Asttypes.label) = let _1 = # 3460 "parsing/parser.mly" - ("+.") -# 24775 "parsing/parser.ml" + ( op ) +# 24684 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24780 "parsing/parser.ml" +# 24689 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24789,24 +24698,28 @@ module Tables = struct 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.semv = op; + MenhirLib.EngineTypes.startp = _startpos_op_; + MenhirLib.EngineTypes.endp = _endpos_op_; MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in - let _1 : unit = Obj.magic _1 in + let op : ( +# 630 "parsing/parser.mly" + (string) +# 24710 "parsing/parser.ml" + ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in - let _startpos = _startpos__1_ in - let _endpos = _endpos__1_ in + let _startpos = _startpos_op_ in + let _endpos = _endpos_op_ in let _v : (Asttypes.label) = let _1 = # 3461 "parsing/parser.mly" - ("+=") -# 24805 "parsing/parser.ml" + ( op ) +# 24718 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24810 "parsing/parser.ml" +# 24723 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24830,13 +24743,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3462 "parsing/parser.mly" - ("-") -# 24835 "parsing/parser.ml" + ("+") +# 24748 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24840 "parsing/parser.ml" +# 24753 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24860,13 +24773,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3463 "parsing/parser.mly" - ("-.") -# 24865 "parsing/parser.ml" + ("+.") +# 24778 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24870 "parsing/parser.ml" +# 24783 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24890,13 +24803,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3464 "parsing/parser.mly" - ("*") -# 24895 "parsing/parser.ml" + ("+=") +# 24808 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24900 "parsing/parser.ml" +# 24813 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24920,13 +24833,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3465 "parsing/parser.mly" - ("%") -# 24925 "parsing/parser.ml" + ("-") +# 24838 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24930 "parsing/parser.ml" +# 24843 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24950,13 +24863,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3466 "parsing/parser.mly" - ("=") -# 24955 "parsing/parser.ml" + ("-.") +# 24868 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24960 "parsing/parser.ml" +# 24873 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24980,13 +24893,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3467 "parsing/parser.mly" - ("<") -# 24985 "parsing/parser.ml" + ("*") +# 24898 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 24990 "parsing/parser.ml" +# 24903 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25010,13 +24923,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3468 "parsing/parser.mly" - (">") -# 25015 "parsing/parser.ml" + ("%") +# 24928 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 25020 "parsing/parser.ml" +# 24933 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25040,13 +24953,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3469 "parsing/parser.mly" - ("or") -# 25045 "parsing/parser.ml" + ("=") +# 24958 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 25050 "parsing/parser.ml" +# 24963 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25070,13 +24983,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3470 "parsing/parser.mly" - ("||") -# 25075 "parsing/parser.ml" + ("<") +# 24988 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 25080 "parsing/parser.ml" +# 24993 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25100,13 +25013,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3471 "parsing/parser.mly" - ("&") -# 25105 "parsing/parser.ml" + (">") +# 25018 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 25110 "parsing/parser.ml" +# 25023 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25130,13 +25043,13 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3472 "parsing/parser.mly" - ("&&") -# 25135 "parsing/parser.ml" + ("or") +# 25048 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 25140 "parsing/parser.ml" +# 25053 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25160,13 +25073,103 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Asttypes.label) = let _1 = # 3473 "parsing/parser.mly" - (":=") -# 25165 "parsing/parser.ml" + ("||") +# 25078 "parsing/parser.ml" in -# 3451 "parsing/parser.mly" +# 3454 "parsing/parser.mly" ( _1 ) -# 25170 "parsing/parser.ml" +# 25083 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 = +# 3474 "parsing/parser.mly" + ("&") +# 25108 "parsing/parser.ml" + in + +# 3454 "parsing/parser.mly" + ( _1 ) +# 25113 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 = +# 3475 "parsing/parser.mly" + ("&&") +# 25138 "parsing/parser.ml" + in + +# 3454 "parsing/parser.mly" + ( _1 ) +# 25143 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 = +# 3476 "parsing/parser.mly" + (":=") +# 25168 "parsing/parser.ml" + in + +# 3454 "parsing/parser.mly" + ( _1 ) +# 25173 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25189,9 +25192,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (bool) = -# 3355 "parsing/parser.mly" +# 3358 "parsing/parser.mly" ( true ) -# 25195 "parsing/parser.ml" +# 25198 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25207,9 +25210,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (bool) = -# 3356 "parsing/parser.mly" +# 3359 "parsing/parser.mly" ( false ) -# 25213 "parsing/parser.ml" +# 25216 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25227,7 +25230,7 @@ module Tables = struct let _v : (unit option) = # 114 "" ( None ) -# 25231 "parsing/parser.ml" +# 25234 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25252,7 +25255,7 @@ module Tables = struct let _v : (unit option) = # 116 "" ( Some x ) -# 25256 "parsing/parser.ml" +# 25259 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25270,7 +25273,7 @@ module Tables = struct let _v : (unit option) = # 114 "" ( None ) -# 25274 "parsing/parser.ml" +# 25277 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25295,7 +25298,7 @@ module Tables = struct let _v : (unit option) = # 116 "" ( Some x ) -# 25299 "parsing/parser.ml" +# 25302 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25313,7 +25316,7 @@ module Tables = struct let _v : (string Asttypes.loc option) = # 114 "" ( None ) -# 25317 "parsing/parser.ml" +# 25320 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25338,9 +25341,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 25344 "parsing/parser.ml" +# 25347 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -25353,21 +25356,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 25359 "parsing/parser.ml" +# 25362 "parsing/parser.ml" in # 183 "" ( x ) -# 25365 "parsing/parser.ml" +# 25368 "parsing/parser.ml" in # 116 "" ( Some x ) -# 25371 "parsing/parser.ml" +# 25374 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25385,7 +25388,7 @@ module Tables = struct let _v : (Parsetree.core_type option) = # 114 "" ( None ) -# 25389 "parsing/parser.ml" +# 25392 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25417,12 +25420,12 @@ module Tables = struct let _v : (Parsetree.core_type option) = let x = # 183 "" ( x ) -# 25421 "parsing/parser.ml" +# 25424 "parsing/parser.ml" in # 116 "" ( Some x ) -# 25426 "parsing/parser.ml" +# 25429 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25440,7 +25443,7 @@ module Tables = struct let _v : (Parsetree.expression option) = # 114 "" ( None ) -# 25444 "parsing/parser.ml" +# 25447 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25472,12 +25475,12 @@ module Tables = struct let _v : (Parsetree.expression option) = let x = # 183 "" ( x ) -# 25476 "parsing/parser.ml" +# 25479 "parsing/parser.ml" in # 116 "" ( Some x ) -# 25481 "parsing/parser.ml" +# 25484 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25495,7 +25498,7 @@ module Tables = struct let _v : (Parsetree.module_type option) = # 114 "" ( None ) -# 25499 "parsing/parser.ml" +# 25502 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25527,12 +25530,12 @@ module Tables = struct let _v : (Parsetree.module_type option) = let x = # 183 "" ( x ) -# 25531 "parsing/parser.ml" +# 25534 "parsing/parser.ml" in # 116 "" ( Some x ) -# 25536 "parsing/parser.ml" +# 25539 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25550,7 +25553,7 @@ module Tables = struct let _v : (Parsetree.pattern option) = # 114 "" ( None ) -# 25554 "parsing/parser.ml" +# 25557 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25582,12 +25585,12 @@ module Tables = struct let _v : (Parsetree.pattern option) = let x = # 183 "" ( x ) -# 25586 "parsing/parser.ml" +# 25589 "parsing/parser.ml" in # 116 "" ( Some x ) -# 25591 "parsing/parser.ml" +# 25594 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25605,7 +25608,7 @@ module Tables = struct let _v : (Parsetree.expression option) = # 114 "" ( None ) -# 25609 "parsing/parser.ml" +# 25612 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25637,12 +25640,12 @@ module Tables = struct let _v : (Parsetree.expression option) = let x = # 183 "" ( x ) -# 25641 "parsing/parser.ml" +# 25644 "parsing/parser.ml" in # 116 "" ( Some x ) -# 25646 "parsing/parser.ml" +# 25649 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25660,7 +25663,7 @@ module Tables = struct let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) = # 114 "" ( None ) -# 25664 "parsing/parser.ml" +# 25667 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25685,7 +25688,7 @@ module Tables = struct let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) = # 116 "" ( Some x ) -# 25689 "parsing/parser.ml" +# 25692 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25704,17 +25707,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 664 "parsing/parser.mly" +# 667 "parsing/parser.mly" (string) -# 25710 "parsing/parser.ml" +# 25713 "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) = -# 3656 "parsing/parser.mly" +# 3659 "parsing/parser.mly" ( _1 ) -# 25718 "parsing/parser.ml" +# 25721 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25746,18 +25749,18 @@ module Tables = struct } = _menhir_stack in let _3 : unit = Obj.magic _3 in let _2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 25752 "parsing/parser.ml" +# 25755 "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) = -# 3657 "parsing/parser.mly" +# 3660 "parsing/parser.mly" ( _2 ) -# 25761 "parsing/parser.ml" +# 25764 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25811,9 +25814,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1249 "parsing/parser.mly" +# 1252 "parsing/parser.mly" ( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) ) -# 25817 "parsing/parser.ml" +# 25820 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25866,9 +25869,9 @@ module Tables = struct 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" +# 1254 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 25872 "parsing/parser.ml" +# 25875 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25905,9 +25908,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.module_expr) = -# 1254 "parsing/parser.mly" +# 1257 "parsing/parser.mly" ( me (* TODO consider reloc *) ) -# 25911 "parsing/parser.ml" +# 25914 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25946,9 +25949,9 @@ module Tables = struct 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" +# 1259 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 25952 "parsing/parser.ml" +# 25955 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25999,25 +26002,25 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.module_expr) = let e = -# 1273 "parsing/parser.mly" +# 1276 "parsing/parser.mly" ( e ) -# 26005 "parsing/parser.ml" +# 26008 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26012 "parsing/parser.ml" +# 26015 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1260 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 26021 "parsing/parser.ml" +# 26024 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26088,11 +26091,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 26096 "parsing/parser.ml" +# 26099 "parsing/parser.ml" in let _endpos_ty_ = _endpos__1_ in @@ -26100,26 +26103,26 @@ module Tables = struct let _startpos = _startpos_e_ in let _loc = (_startpos, _endpos) in -# 1275 "parsing/parser.mly" +# 1278 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) ) -# 26106 "parsing/parser.ml" +# 26109 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26114 "parsing/parser.ml" +# 26117 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1260 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 26123 "parsing/parser.ml" +# 26126 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26205,11 +26208,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 26213 "parsing/parser.ml" +# 26216 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_inlined1_ in @@ -26218,37 +26221,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 26226 "parsing/parser.ml" +# 26229 "parsing/parser.ml" in let _endpos = _endpos_ty2_ in let _startpos = _startpos_e_ in let _loc = (_startpos, _endpos) in -# 1277 "parsing/parser.mly" +# 1280 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) ) -# 26235 "parsing/parser.ml" +# 26238 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26243 "parsing/parser.ml" +# 26246 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1260 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 26252 "parsing/parser.ml" +# 26255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26319,11 +26322,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 26327 "parsing/parser.ml" +# 26330 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_ in @@ -26331,26 +26334,26 @@ module Tables = struct let _startpos = _startpos_e_ in let _loc = (_startpos, _endpos) in -# 1279 "parsing/parser.mly" +# 1282 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) ) -# 26337 "parsing/parser.ml" +# 26340 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26345 "parsing/parser.ml" +# 26348 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1260 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 26354 "parsing/parser.ml" +# 26357 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26410,17 +26413,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _3 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26416 "parsing/parser.ml" +# 26419 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1262 "parsing/parser.mly" +# 1265 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 26424 "parsing/parser.ml" +# 26427 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26480,17 +26483,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _3 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26486 "parsing/parser.ml" +# 26489 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1264 "parsing/parser.mly" +# 1267 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 26494 "parsing/parser.ml" +# 26497 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26543,17 +26546,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _3 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 26549 "parsing/parser.ml" +# 26552 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1266 "parsing/parser.mly" +# 1269 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 26557 "parsing/parser.ml" +# 26560 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26583,13 +26586,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 801 "parsing/parser.mly" +# 804 "parsing/parser.mly" (Longident.t) -# 26589 "parsing/parser.ml" +# 26592 "parsing/parser.ml" ) = -# 1170 "parsing/parser.mly" +# 1173 "parsing/parser.mly" ( _1 ) -# 26593 "parsing/parser.ml" +# 26596 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26619,13 +26622,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 791 "parsing/parser.mly" +# 794 "parsing/parser.mly" (Longident.t) -# 26625 "parsing/parser.ml" +# 26628 "parsing/parser.ml" ) = -# 1155 "parsing/parser.mly" +# 1158 "parsing/parser.mly" ( _1 ) -# 26629 "parsing/parser.ml" +# 26632 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26655,13 +26658,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 785 "parsing/parser.mly" +# 788 "parsing/parser.mly" (Parsetree.core_type) -# 26661 "parsing/parser.ml" +# 26664 "parsing/parser.ml" ) = -# 1130 "parsing/parser.mly" +# 1133 "parsing/parser.mly" ( _1 ) -# 26665 "parsing/parser.ml" +# 26668 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26691,13 +26694,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 787 "parsing/parser.mly" +# 790 "parsing/parser.mly" (Parsetree.expression) -# 26697 "parsing/parser.ml" +# 26700 "parsing/parser.ml" ) = -# 1135 "parsing/parser.mly" +# 1138 "parsing/parser.mly" ( _1 ) -# 26701 "parsing/parser.ml" +# 26704 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26727,13 +26730,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 797 "parsing/parser.mly" +# 800 "parsing/parser.mly" (Longident.t) -# 26733 "parsing/parser.ml" +# 26736 "parsing/parser.ml" ) = -# 1160 "parsing/parser.mly" +# 1163 "parsing/parser.mly" ( _1 ) -# 26737 "parsing/parser.ml" +# 26740 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26763,13 +26766,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 799 "parsing/parser.mly" +# 802 "parsing/parser.mly" (Longident.t) -# 26769 "parsing/parser.ml" +# 26772 "parsing/parser.ml" ) = -# 1165 "parsing/parser.mly" +# 1168 "parsing/parser.mly" ( _1 ) -# 26773 "parsing/parser.ml" +# 26776 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26799,13 +26802,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 795 "parsing/parser.mly" +# 798 "parsing/parser.mly" (Longident.t) -# 26805 "parsing/parser.ml" +# 26808 "parsing/parser.ml" ) = -# 1145 "parsing/parser.mly" +# 1148 "parsing/parser.mly" ( _1 ) -# 26809 "parsing/parser.ml" +# 26812 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26835,13 +26838,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 789 "parsing/parser.mly" +# 792 "parsing/parser.mly" (Parsetree.pattern) -# 26841 "parsing/parser.ml" +# 26844 "parsing/parser.ml" ) = -# 1140 "parsing/parser.mly" +# 1143 "parsing/parser.mly" ( _1 ) -# 26845 "parsing/parser.ml" +# 26848 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26871,13 +26874,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 793 "parsing/parser.mly" +# 796 "parsing/parser.mly" (Longident.t) -# 26877 "parsing/parser.ml" +# 26880 "parsing/parser.ml" ) = -# 1150 "parsing/parser.mly" +# 1153 "parsing/parser.mly" ( _1 ) -# 26881 "parsing/parser.ml" +# 26884 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26919,15 +26922,15 @@ module Tables = struct let _loc__2_ = (_startpos__2_, _endpos__2_) in let _sloc = (_symbolstartpos, _endpos) in -# 2631 "parsing/parser.mly" +# 2634 "parsing/parser.mly" ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) ) -# 26925 "parsing/parser.ml" +# 26928 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 26931 "parsing/parser.ml" +# 26934 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26957,14 +26960,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = -# 2633 "parsing/parser.mly" +# 2636 "parsing/parser.mly" ( Pat.attr _1 _2 ) -# 26963 "parsing/parser.ml" +# 26966 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 26968 "parsing/parser.ml" +# 26971 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26987,14 +26990,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = -# 2635 "parsing/parser.mly" +# 2638 "parsing/parser.mly" ( _1 ) -# 26993 "parsing/parser.ml" +# 26996 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 26998 "parsing/parser.ml" +# 27001 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27039,15 +27042,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27045 "parsing/parser.ml" +# 27048 "parsing/parser.ml" in -# 2638 "parsing/parser.mly" +# 2641 "parsing/parser.mly" ( Ppat_alias(_1, _3) ) -# 27051 "parsing/parser.ml" +# 27054 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -27055,21 +27058,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27061 "parsing/parser.ml" +# 27064 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 27067 "parsing/parser.ml" +# 27070 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 27073 "parsing/parser.ml" +# 27076 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27110,9 +27113,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2640 "parsing/parser.mly" +# 2643 "parsing/parser.mly" ( expecting _loc__3_ "identifier" ) -# 27116 "parsing/parser.ml" +# 27119 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -27120,21 +27123,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27126 "parsing/parser.ml" +# 27129 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 27132 "parsing/parser.ml" +# 27135 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 27138 "parsing/parser.ml" +# 27141 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27159,29 +27162,29 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2642 "parsing/parser.mly" +# 2645 "parsing/parser.mly" ( Ppat_tuple(List.rev _1) ) -# 27165 "parsing/parser.ml" +# 27168 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27173 "parsing/parser.ml" +# 27176 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 27179 "parsing/parser.ml" +# 27182 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 27185 "parsing/parser.ml" +# 27188 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27222,9 +27225,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2644 "parsing/parser.mly" +# 2647 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 27228 "parsing/parser.ml" +# 27231 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -27232,21 +27235,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27238 "parsing/parser.ml" +# 27241 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 27244 "parsing/parser.ml" +# 27247 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 27250 "parsing/parser.ml" +# 27253 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27285,30 +27288,30 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2646 "parsing/parser.mly" +# 2649 "parsing/parser.mly" ( Ppat_or(_1, _3) ) -# 27291 "parsing/parser.ml" +# 27294 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27300 "parsing/parser.ml" +# 27303 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 27306 "parsing/parser.ml" +# 27309 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 27312 "parsing/parser.ml" +# 27315 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27349,9 +27352,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2648 "parsing/parser.mly" +# 2651 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 27355 "parsing/parser.ml" +# 27358 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -27359,21 +27362,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27365 "parsing/parser.ml" +# 27368 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 27371 "parsing/parser.ml" +# 27374 "parsing/parser.ml" in -# 2619 "parsing/parser.mly" +# 2622 "parsing/parser.mly" ( _1 ) -# 27377 "parsing/parser.ml" +# 27380 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27421,24 +27424,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 27427 "parsing/parser.ml" +# 27430 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 27433 "parsing/parser.ml" +# 27436 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2621 "parsing/parser.mly" +# 2624 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2) -# 27442 "parsing/parser.ml" +# 27445 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27475,9 +27478,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2745 "parsing/parser.mly" +# 2748 "parsing/parser.mly" ( _3 :: _1 ) -# 27481 "parsing/parser.ml" +# 27484 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27514,9 +27517,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2746 "parsing/parser.mly" +# 2749 "parsing/parser.mly" ( [_3; _1] ) -# 27520 "parsing/parser.ml" +# 27523 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27554,9 +27557,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2747 "parsing/parser.mly" +# 2750 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 27560 "parsing/parser.ml" +# 27563 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27593,9 +27596,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2745 "parsing/parser.mly" +# 2748 "parsing/parser.mly" ( _3 :: _1 ) -# 27599 "parsing/parser.ml" +# 27602 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27632,9 +27635,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2746 "parsing/parser.mly" +# 2749 "parsing/parser.mly" ( [_3; _1] ) -# 27638 "parsing/parser.ml" +# 27641 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27672,9 +27675,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2747 "parsing/parser.mly" +# 2750 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 27678 "parsing/parser.ml" +# 27681 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27697,9 +27700,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2654 "parsing/parser.mly" +# 2657 "parsing/parser.mly" ( _1 ) -# 27703 "parsing/parser.ml" +# 27706 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27735,15 +27738,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27741 "parsing/parser.ml" +# 27744 "parsing/parser.ml" in -# 2657 "parsing/parser.mly" +# 2660 "parsing/parser.mly" ( Ppat_construct(_1, Some _2) ) -# 27747 "parsing/parser.ml" +# 27750 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -27751,15 +27754,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27757 "parsing/parser.ml" +# 27760 "parsing/parser.ml" in -# 2660 "parsing/parser.mly" +# 2663 "parsing/parser.mly" ( _1 ) -# 27763 "parsing/parser.ml" +# 27766 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27790,24 +27793,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2659 "parsing/parser.mly" +# 2662 "parsing/parser.mly" ( Ppat_variant(_1, Some _2) ) -# 27796 "parsing/parser.ml" +# 27799 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27805 "parsing/parser.ml" +# 27808 "parsing/parser.ml" in -# 2660 "parsing/parser.mly" +# 2663 "parsing/parser.mly" ( _1 ) -# 27811 "parsing/parser.ml" +# 27814 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27855,24 +27858,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 27861 "parsing/parser.ml" +# 27864 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 27867 "parsing/parser.ml" +# 27870 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2662 "parsing/parser.mly" +# 2665 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2) -# 27876 "parsing/parser.ml" +# 27879 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27914,15 +27917,15 @@ module Tables = struct let _loc__2_ = (_startpos__2_, _endpos__2_) in let _sloc = (_symbolstartpos, _endpos) in -# 2631 "parsing/parser.mly" +# 2634 "parsing/parser.mly" ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) ) -# 27920 "parsing/parser.ml" +# 27923 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 27926 "parsing/parser.ml" +# 27929 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27952,14 +27955,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = -# 2633 "parsing/parser.mly" +# 2636 "parsing/parser.mly" ( Pat.attr _1 _2 ) -# 27958 "parsing/parser.ml" +# 27961 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 27963 "parsing/parser.ml" +# 27966 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27982,14 +27985,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = -# 2635 "parsing/parser.mly" +# 2638 "parsing/parser.mly" ( _1 ) -# 27988 "parsing/parser.ml" +# 27991 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 27993 "parsing/parser.ml" +# 27996 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28034,15 +28037,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 28040 "parsing/parser.ml" +# 28043 "parsing/parser.ml" in -# 2638 "parsing/parser.mly" +# 2641 "parsing/parser.mly" ( Ppat_alias(_1, _3) ) -# 28046 "parsing/parser.ml" +# 28049 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -28050,21 +28053,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28056 "parsing/parser.ml" +# 28059 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 28062 "parsing/parser.ml" +# 28065 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 28068 "parsing/parser.ml" +# 28071 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28105,9 +28108,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2640 "parsing/parser.mly" +# 2643 "parsing/parser.mly" ( expecting _loc__3_ "identifier" ) -# 28111 "parsing/parser.ml" +# 28114 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -28115,21 +28118,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28121 "parsing/parser.ml" +# 28124 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 28127 "parsing/parser.ml" +# 28130 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 28133 "parsing/parser.ml" +# 28136 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28154,29 +28157,29 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2642 "parsing/parser.mly" +# 2645 "parsing/parser.mly" ( Ppat_tuple(List.rev _1) ) -# 28160 "parsing/parser.ml" +# 28163 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28168 "parsing/parser.ml" +# 28171 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 28174 "parsing/parser.ml" +# 28177 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 28180 "parsing/parser.ml" +# 28183 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28217,9 +28220,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2644 "parsing/parser.mly" +# 2647 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 28223 "parsing/parser.ml" +# 28226 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -28227,21 +28230,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28233 "parsing/parser.ml" +# 28236 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 28239 "parsing/parser.ml" +# 28242 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 28245 "parsing/parser.ml" +# 28248 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28280,30 +28283,30 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2646 "parsing/parser.mly" +# 2649 "parsing/parser.mly" ( Ppat_or(_1, _3) ) -# 28286 "parsing/parser.ml" +# 28289 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28295 "parsing/parser.ml" +# 28298 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 28301 "parsing/parser.ml" +# 28304 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 28307 "parsing/parser.ml" +# 28310 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28344,9 +28347,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2648 "parsing/parser.mly" +# 2651 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 28350 "parsing/parser.ml" +# 28353 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -28354,21 +28357,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28360 "parsing/parser.ml" +# 28363 "parsing/parser.ml" in -# 2649 "parsing/parser.mly" +# 2652 "parsing/parser.mly" ( _1 ) -# 28366 "parsing/parser.ml" +# 28369 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( _1 ) -# 28372 "parsing/parser.ml" +# 28375 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28387,9 +28390,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 28393 "parsing/parser.ml" +# 28396 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -28401,30 +28404,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 28407 "parsing/parser.ml" +# 28410 "parsing/parser.ml" in -# 2104 "parsing/parser.mly" +# 2107 "parsing/parser.mly" ( Ppat_var _1 ) -# 28413 "parsing/parser.ml" +# 28416 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28422 "parsing/parser.ml" +# 28425 "parsing/parser.ml" in -# 2106 "parsing/parser.mly" +# 2109 "parsing/parser.mly" ( _1 ) -# 28428 "parsing/parser.ml" +# 28431 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28448,23 +28451,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2105 "parsing/parser.mly" +# 2108 "parsing/parser.mly" ( Ppat_any ) -# 28454 "parsing/parser.ml" +# 28457 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 28462 "parsing/parser.ml" +# 28465 "parsing/parser.ml" in -# 2106 "parsing/parser.mly" +# 2109 "parsing/parser.mly" ( _1 ) -# 28468 "parsing/parser.ml" +# 28471 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28487,9 +28490,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.payload) = -# 3766 "parsing/parser.mly" +# 3769 "parsing/parser.mly" ( PStr _1 ) -# 28493 "parsing/parser.ml" +# 28496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28519,9 +28522,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.payload) = -# 3767 "parsing/parser.mly" +# 3770 "parsing/parser.mly" ( PSig _2 ) -# 28525 "parsing/parser.ml" +# 28528 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28551,9 +28554,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.payload) = -# 3768 "parsing/parser.mly" +# 3771 "parsing/parser.mly" ( PTyp _2 ) -# 28557 "parsing/parser.ml" +# 28560 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28583,9 +28586,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.payload) = -# 3769 "parsing/parser.mly" +# 3772 "parsing/parser.mly" ( PPat (_2, None) ) -# 28589 "parsing/parser.ml" +# 28592 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28629,9 +28632,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.payload) = -# 3770 "parsing/parser.mly" +# 3773 "parsing/parser.mly" ( PPat (_2, Some _4) ) -# 28635 "parsing/parser.ml" +# 28638 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28654,9 +28657,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = -# 3169 "parsing/parser.mly" +# 3172 "parsing/parser.mly" ( _1 ) -# 28660 "parsing/parser.ml" +# 28663 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28699,24 +28702,24 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 28703 "parsing/parser.ml" +# 28706 "parsing/parser.ml" in -# 915 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 28708 "parsing/parser.ml" +# 28711 "parsing/parser.ml" in -# 3161 "parsing/parser.mly" +# 3164 "parsing/parser.mly" ( _1 ) -# 28714 "parsing/parser.ml" +# 28717 "parsing/parser.ml" in -# 3165 "parsing/parser.mly" +# 3168 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 28720 "parsing/parser.ml" +# 28723 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in @@ -28724,15 +28727,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 28730 "parsing/parser.ml" +# 28733 "parsing/parser.ml" in -# 3171 "parsing/parser.mly" +# 3174 "parsing/parser.mly" ( _1 ) -# 28736 "parsing/parser.ml" +# 28739 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28755,14 +28758,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 28761 "parsing/parser.ml" +# 28764 "parsing/parser.ml" in -# 3169 "parsing/parser.mly" +# 3172 "parsing/parser.mly" ( _1 ) -# 28766 "parsing/parser.ml" +# 28769 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28801,33 +28804,33 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let _3 = -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 28807 "parsing/parser.ml" +# 28810 "parsing/parser.ml" in let _1 = let _1 = let xs = # 253 "" ( List.rev xs ) -# 28814 "parsing/parser.ml" +# 28817 "parsing/parser.ml" in -# 915 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 28819 "parsing/parser.ml" +# 28822 "parsing/parser.ml" in -# 3161 "parsing/parser.mly" +# 3164 "parsing/parser.mly" ( _1 ) -# 28825 "parsing/parser.ml" +# 28828 "parsing/parser.ml" in -# 3165 "parsing/parser.mly" +# 3168 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 28831 "parsing/parser.ml" +# 28834 "parsing/parser.ml" in let _startpos__1_ = _startpos_xs_ in @@ -28835,15 +28838,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 28841 "parsing/parser.ml" +# 28844 "parsing/parser.ml" in -# 3171 "parsing/parser.mly" +# 3174 "parsing/parser.mly" ( _1 ) -# 28847 "parsing/parser.ml" +# 28850 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28890,9 +28893,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3729 "parsing/parser.mly" +# 3732 "parsing/parser.mly" ( Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 28896 "parsing/parser.ml" +# 28899 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28973,9 +28976,9 @@ module Tables = struct let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 28979 "parsing/parser.ml" +# 28982 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -28985,30 +28988,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 28991 "parsing/parser.ml" +# 28994 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 28999 "parsing/parser.ml" +# 29002 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2806 "parsing/parser.mly" +# 2809 "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 ) -# 29012 "parsing/parser.ml" +# 29015 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29024,14 +29027,14 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.private_flag) = let _1 = -# 3597 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( Public ) -# 29030 "parsing/parser.ml" +# 29033 "parsing/parser.ml" in -# 3594 "parsing/parser.mly" +# 3597 "parsing/parser.mly" ( _1 ) -# 29035 "parsing/parser.ml" +# 29038 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29054,14 +29057,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag) = let _1 = -# 3598 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( Private ) -# 29060 "parsing/parser.ml" +# 29063 "parsing/parser.ml" in -# 3594 "parsing/parser.mly" +# 3597 "parsing/parser.mly" ( _1 ) -# 29065 "parsing/parser.ml" +# 29068 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29077,91 +29080,59 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3620 "parsing/parser.mly" - ( Public, Concrete ) -# 29083 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) = -# 3621 "parsing/parser.mly" - ( Private, Concrete ) -# 29108 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) = -# 3622 "parsing/parser.mly" - ( Public, Virtual ) -# 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 = _; - MenhirLib.EngineTypes.semv = _2; - MenhirLib.EngineTypes.startp = _startpos__2_; - MenhirLib.EngineTypes.endp = _endpos__2_; - MenhirLib.EngineTypes.next = { - MenhirLib.EngineTypes.state = _menhir_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) = # 3623 "parsing/parser.mly" - ( Private, Virtual ) -# 29165 "parsing/parser.ml" + ( Public, Concrete ) +# 29086 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = +# 3624 "parsing/parser.mly" + ( Private, Concrete ) +# 29111 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = +# 3625 "parsing/parser.mly" + ( Public, Virtual ) +# 29136 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29191,9 +29162,41 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3624 "parsing/parser.mly" +# 3626 "parsing/parser.mly" ( Private, Virtual ) -# 29197 "parsing/parser.ml" +# 29168 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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) = +# 3627 "parsing/parser.mly" + ( Private, Virtual ) +# 29200 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29209,9 +29212,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.rec_flag) = -# 3577 "parsing/parser.mly" +# 3580 "parsing/parser.mly" ( Nonrecursive ) -# 29215 "parsing/parser.ml" +# 29218 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29234,9 +29237,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.rec_flag) = -# 3578 "parsing/parser.mly" +# 3581 "parsing/parser.mly" ( Recursive ) -# 29240 "parsing/parser.ml" +# 29243 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29262,12 +29265,12 @@ module Tables = struct (Longident.t Asttypes.loc * Parsetree.expression) list) = let eo = # 124 "" ( None ) -# 29266 "parsing/parser.ml" +# 29269 "parsing/parser.ml" in -# 2551 "parsing/parser.mly" +# 2554 "parsing/parser.mly" ( eo, fields ) -# 29271 "parsing/parser.ml" +# 29274 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29308,18 +29311,18 @@ module Tables = struct let x = # 191 "" ( x ) -# 29312 "parsing/parser.ml" +# 29315 "parsing/parser.ml" in # 126 "" ( Some x ) -# 29317 "parsing/parser.ml" +# 29320 "parsing/parser.ml" in -# 2551 "parsing/parser.mly" +# 2554 "parsing/parser.mly" ( eo, fields ) -# 29323 "parsing/parser.ml" +# 29326 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29344,52 +29347,52 @@ module Tables = struct let _startpos = _startpos_d_ in let _endpos = _endpos_d_ in let _v : (Parsetree.constructor_declaration list) = let x = -# 2991 "parsing/parser.mly" +# 2994 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Type.constructor cid ~args ?res ~attrs ~loc ~info ) -# 29353 "parsing/parser.ml" - in - -# 1025 "parsing/parser.mly" - ( [x] ) -# 29358 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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 = -# 2991 "parsing/parser.mly" - ( - let cid, args, res, attrs, loc, info = d in - Type.constructor cid ~args ?res ~attrs ~loc ~info - ) -# 29388 "parsing/parser.ml" +# 29356 "parsing/parser.ml" in # 1028 "parsing/parser.mly" ( [x] ) -# 29393 "parsing/parser.ml" +# 29361 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 = +# 2994 "parsing/parser.mly" + ( + let cid, args, res, attrs, loc, info = d in + Type.constructor cid ~args ?res ~attrs ~loc ~info + ) +# 29391 "parsing/parser.ml" + in + +# 1031 "parsing/parser.mly" + ( [x] ) +# 29396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29421,17 +29424,17 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_d_ in let _v : (Parsetree.constructor_declaration list) = let x = -# 2991 "parsing/parser.mly" +# 2994 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Type.constructor cid ~args ?res ~attrs ~loc ~info ) -# 29430 "parsing/parser.ml" +# 29433 "parsing/parser.ml" in -# 1032 "parsing/parser.mly" +# 1035 "parsing/parser.mly" ( x :: xs ) -# 29435 "parsing/parser.ml" +# 29438 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29457,23 +29460,23 @@ module Tables = struct let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = let _1 = -# 3103 "parsing/parser.mly" +# 3106 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 29466 "parsing/parser.ml" +# 29469 "parsing/parser.ml" in -# 3097 "parsing/parser.mly" +# 3100 "parsing/parser.mly" ( _1 ) -# 29471 "parsing/parser.ml" +# 29474 "parsing/parser.ml" in -# 1025 "parsing/parser.mly" +# 1028 "parsing/parser.mly" ( [x] ) -# 29477 "parsing/parser.ml" +# 29480 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29496,14 +29499,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3099 "parsing/parser.mly" +# 3102 "parsing/parser.mly" ( _1 ) -# 29502 "parsing/parser.ml" +# 29505 "parsing/parser.ml" in -# 1025 "parsing/parser.mly" +# 1028 "parsing/parser.mly" ( [x] ) -# 29507 "parsing/parser.ml" +# 29510 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29529,23 +29532,23 @@ module Tables = struct let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = let _1 = -# 3103 "parsing/parser.mly" +# 3106 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 29538 "parsing/parser.ml" +# 29541 "parsing/parser.ml" in -# 3097 "parsing/parser.mly" +# 3100 "parsing/parser.mly" ( _1 ) -# 29543 "parsing/parser.ml" +# 29546 "parsing/parser.ml" in -# 1028 "parsing/parser.mly" +# 1031 "parsing/parser.mly" ( [x] ) -# 29549 "parsing/parser.ml" +# 29552 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29568,14 +29571,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3099 "parsing/parser.mly" +# 3102 "parsing/parser.mly" ( _1 ) -# 29574 "parsing/parser.ml" +# 29577 "parsing/parser.ml" in -# 1028 "parsing/parser.mly" +# 1031 "parsing/parser.mly" ( [x] ) -# 29579 "parsing/parser.ml" +# 29582 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29608,23 +29611,23 @@ module Tables = struct let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = let _1 = -# 3103 "parsing/parser.mly" +# 3106 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 29617 "parsing/parser.ml" +# 29620 "parsing/parser.ml" in -# 3097 "parsing/parser.mly" +# 3100 "parsing/parser.mly" ( _1 ) -# 29622 "parsing/parser.ml" +# 29625 "parsing/parser.ml" in -# 1032 "parsing/parser.mly" +# 1035 "parsing/parser.mly" ( x :: xs ) -# 29628 "parsing/parser.ml" +# 29631 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29654,14 +29657,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos__1_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3099 "parsing/parser.mly" +# 3102 "parsing/parser.mly" ( _1 ) -# 29660 "parsing/parser.ml" +# 29663 "parsing/parser.ml" in -# 1032 "parsing/parser.mly" +# 1035 "parsing/parser.mly" ( x :: xs ) -# 29665 "parsing/parser.ml" +# 29668 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29686,52 +29689,52 @@ module Tables = struct let _startpos = _startpos_d_ in let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3103 "parsing/parser.mly" +# 3106 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 29695 "parsing/parser.ml" - in - -# 1025 "parsing/parser.mly" - ( [x] ) -# 29700 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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 = -# 3103 "parsing/parser.mly" - ( - let cid, args, res, attrs, loc, info = d in - Te.decl cid ~args ?res ~attrs ~loc ~info - ) -# 29730 "parsing/parser.ml" +# 29698 "parsing/parser.ml" in # 1028 "parsing/parser.mly" ( [x] ) -# 29735 "parsing/parser.ml" +# 29703 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 = +# 3106 "parsing/parser.mly" + ( + let cid, args, res, attrs, loc, info = d in + Te.decl cid ~args ?res ~attrs ~loc ~info + ) +# 29733 "parsing/parser.ml" + in + +# 1031 "parsing/parser.mly" + ( [x] ) +# 29738 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29763,17 +29766,17 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3103 "parsing/parser.mly" +# 3106 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 29772 "parsing/parser.ml" +# 29775 "parsing/parser.ml" in -# 1032 "parsing/parser.mly" +# 1035 "parsing/parser.mly" ( x :: xs ) -# 29777 "parsing/parser.ml" +# 29780 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29789,9 +29792,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = -# 891 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( [] ) -# 29795 "parsing/parser.ml" +# 29798 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29848,21 +29851,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1984 "parsing/parser.mly" +# 1987 "parsing/parser.mly" ( _1, _3, make_loc _sloc ) -# 29854 "parsing/parser.ml" +# 29857 "parsing/parser.ml" in # 183 "" ( x ) -# 29860 "parsing/parser.ml" +# 29863 "parsing/parser.ml" in -# 893 "parsing/parser.mly" +# 896 "parsing/parser.mly" ( x :: xs ) -# 29866 "parsing/parser.ml" +# 29869 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29885,9 +29888,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.functor_parameter list) = -# 905 "parsing/parser.mly" +# 908 "parsing/parser.mly" ( [ x ] ) -# 29891 "parsing/parser.ml" +# 29894 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29917,9 +29920,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.functor_parameter list) = -# 907 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( x :: xs ) -# 29923 "parsing/parser.ml" +# 29926 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29942,9 +29945,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : ((Asttypes.arg_label * Parsetree.expression) list) = -# 905 "parsing/parser.mly" +# 908 "parsing/parser.mly" ( [ x ] ) -# 29948 "parsing/parser.ml" +# 29951 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29974,9 +29977,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : ((Asttypes.arg_label * Parsetree.expression) list) = -# 907 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( x :: xs ) -# 29980 "parsing/parser.ml" +# 29983 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29999,9 +30002,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Asttypes.label list) = -# 905 "parsing/parser.mly" +# 908 "parsing/parser.mly" ( [ x ] ) -# 30005 "parsing/parser.ml" +# 30008 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30031,9 +30034,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Asttypes.label list) = -# 907 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( x :: xs ) -# 30037 "parsing/parser.ml" +# 30040 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30069,21 +30072,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30075 "parsing/parser.ml" +# 30078 "parsing/parser.ml" in -# 3157 "parsing/parser.mly" +# 3160 "parsing/parser.mly" ( _2 ) -# 30081 "parsing/parser.ml" +# 30084 "parsing/parser.ml" in -# 905 "parsing/parser.mly" +# 908 "parsing/parser.mly" ( [ x ] ) -# 30087 "parsing/parser.ml" +# 30090 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30126,21 +30129,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30132 "parsing/parser.ml" +# 30135 "parsing/parser.ml" in -# 3157 "parsing/parser.mly" +# 3160 "parsing/parser.mly" ( _2 ) -# 30138 "parsing/parser.ml" +# 30141 "parsing/parser.ml" in -# 907 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( x :: xs ) -# 30144 "parsing/parser.ml" +# 30147 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30165,12 +30168,12 @@ module Tables = struct let _v : (Parsetree.case list) = let _1 = # 124 "" ( None ) -# 30169 "parsing/parser.ml" +# 30172 "parsing/parser.ml" in -# 996 "parsing/parser.mly" +# 999 "parsing/parser.mly" ( [x] ) -# 30174 "parsing/parser.ml" +# 30177 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30204,13 +30207,13 @@ module Tables = struct # 126 "" ( Some x ) -# 30208 "parsing/parser.ml" +# 30211 "parsing/parser.ml" in -# 996 "parsing/parser.mly" +# 999 "parsing/parser.mly" ( [x] ) -# 30214 "parsing/parser.ml" +# 30217 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30247,9 +30250,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.case list) = -# 1000 "parsing/parser.mly" +# 1003 "parsing/parser.mly" ( x :: xs ) -# 30253 "parsing/parser.ml" +# 30256 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30273,20 +30276,20 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type list) = let xs = let x = -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 30279 "parsing/parser.ml" +# 30282 "parsing/parser.ml" in -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 30284 "parsing/parser.ml" +# 30287 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30290 "parsing/parser.ml" +# 30293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30324,20 +30327,20 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type list) = let xs = let x = -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 30330 "parsing/parser.ml" +# 30333 "parsing/parser.ml" in -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 30335 "parsing/parser.ml" +# 30338 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30341 "parsing/parser.ml" +# 30344 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30360,14 +30363,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.with_constraint list) = let xs = -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 30366 "parsing/parser.ml" +# 30369 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30371 "parsing/parser.ml" +# 30374 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30404,14 +30407,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.with_constraint list) = let xs = -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 30410 "parsing/parser.ml" +# 30413 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30415 "parsing/parser.ml" +# 30418 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30434,14 +30437,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.row_field list) = let xs = -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 30440 "parsing/parser.ml" +# 30443 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30445 "parsing/parser.ml" +# 30448 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30478,14 +30481,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.row_field list) = let xs = -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 30484 "parsing/parser.ml" +# 30487 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30489 "parsing/parser.ml" +# 30492 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30508,14 +30511,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 30514 "parsing/parser.ml" +# 30517 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30519 "parsing/parser.ml" +# 30522 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30552,14 +30555,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 30558 "parsing/parser.ml" +# 30561 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30563 "parsing/parser.ml" +# 30566 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30582,14 +30585,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs = -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 30588 "parsing/parser.ml" +# 30591 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30593 "parsing/parser.ml" +# 30596 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30626,14 +30629,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs = -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 30632 "parsing/parser.ml" +# 30635 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30637 "parsing/parser.ml" +# 30640 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30656,14 +30659,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 931 "parsing/parser.mly" +# 934 "parsing/parser.mly" ( [ x ] ) -# 30662 "parsing/parser.ml" +# 30665 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30667 "parsing/parser.ml" +# 30670 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30700,14 +30703,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 935 "parsing/parser.mly" +# 938 "parsing/parser.mly" ( x :: xs ) -# 30706 "parsing/parser.ml" +# 30709 "parsing/parser.ml" in -# 939 "parsing/parser.mly" +# 942 "parsing/parser.mly" ( xs ) -# 30711 "parsing/parser.ml" +# 30714 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30744,9 +30747,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = -# 962 "parsing/parser.mly" +# 965 "parsing/parser.mly" ( x :: xs ) -# 30750 "parsing/parser.ml" +# 30753 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30783,9 +30786,9 @@ module Tables = struct let _startpos = _startpos_x1_ in let _endpos = _endpos_x2_ in let _v : (Parsetree.core_type list) = -# 966 "parsing/parser.mly" +# 969 "parsing/parser.mly" ( [ x2; x1 ] ) -# 30789 "parsing/parser.ml" +# 30792 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30822,9 +30825,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.expression list) = -# 962 "parsing/parser.mly" +# 965 "parsing/parser.mly" ( x :: xs ) -# 30828 "parsing/parser.ml" +# 30831 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30861,9 +30864,9 @@ module Tables = struct let _startpos = _startpos_x1_ in let _endpos = _endpos_x2_ in let _v : (Parsetree.expression list) = -# 966 "parsing/parser.mly" +# 969 "parsing/parser.mly" ( [ x2; x1 ] ) -# 30867 "parsing/parser.ml" +# 30870 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30900,9 +30903,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = -# 962 "parsing/parser.mly" +# 965 "parsing/parser.mly" ( x :: xs ) -# 30906 "parsing/parser.ml" +# 30909 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30939,9 +30942,9 @@ module Tables = struct let _startpos = _startpos_x1_ in let _endpos = _endpos_x2_ in let _v : (Parsetree.core_type list) = -# 966 "parsing/parser.mly" +# 969 "parsing/parser.mly" ( [ x2; x1 ] ) -# 30945 "parsing/parser.ml" +# 30948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30964,9 +30967,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.row_field) = -# 3340 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 30970 "parsing/parser.ml" +# 30973 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30992,9 +30995,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3342 "parsing/parser.mly" +# 3345 "parsing/parser.mly" ( Rf.inherit_ ~loc:(make_loc _sloc) _1 ) -# 30998 "parsing/parser.ml" +# 31001 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31019,12 +31022,12 @@ module Tables = struct let _v : (Parsetree.expression list) = let _2 = # 124 "" ( None ) -# 31023 "parsing/parser.ml" +# 31026 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31028 "parsing/parser.ml" +# 31031 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31058,13 +31061,13 @@ module Tables = struct # 126 "" ( Some x ) -# 31062 "parsing/parser.ml" +# 31065 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31068 "parsing/parser.ml" +# 31071 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31101,9 +31104,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_xs_ in let _v : (Parsetree.expression list) = -# 987 "parsing/parser.mly" +# 990 "parsing/parser.mly" ( x :: xs ) -# 31107 "parsing/parser.ml" +# 31110 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31129,9 +31132,9 @@ module Tables = struct } = _menhir_stack in let oe : (Parsetree.expression option) = Obj.magic oe in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 31135 "parsing/parser.ml" +# 31138 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -31139,22 +31142,22 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = # 124 "" ( None ) -# 31143 "parsing/parser.ml" +# 31146 "parsing/parser.ml" in let x = let label = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 31150 "parsing/parser.ml" +# 31153 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31158 "parsing/parser.ml" +# 31161 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -31162,7 +31165,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2574 "parsing/parser.mly" +# 2577 "parsing/parser.mly" ( let e = match oe with | None -> @@ -31172,13 +31175,13 @@ module Tables = struct e in label, e ) -# 31176 "parsing/parser.ml" +# 31179 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31182 "parsing/parser.ml" +# 31185 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31211,9 +31214,9 @@ module Tables = struct let x : unit = Obj.magic x in let oe : (Parsetree.expression option) = Obj.magic oe in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 31217 "parsing/parser.ml" +# 31220 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -31221,22 +31224,22 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = # 126 "" ( Some x ) -# 31225 "parsing/parser.ml" +# 31228 "parsing/parser.ml" in let x = let label = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 31232 "parsing/parser.ml" +# 31235 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31240 "parsing/parser.ml" +# 31243 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -31244,7 +31247,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2574 "parsing/parser.mly" +# 2577 "parsing/parser.mly" ( let e = match oe with | None -> @@ -31254,13 +31257,13 @@ module Tables = struct e in label, e ) -# 31258 "parsing/parser.ml" +# 31261 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31264 "parsing/parser.ml" +# 31267 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31300,9 +31303,9 @@ module Tables = struct let _2 : unit = Obj.magic _2 in let oe : (Parsetree.expression option) = Obj.magic oe in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 31306 "parsing/parser.ml" +# 31309 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -31310,17 +31313,17 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let x = let label = let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 31316 "parsing/parser.ml" +# 31319 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31324 "parsing/parser.ml" +# 31327 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -31328,7 +31331,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2574 "parsing/parser.mly" +# 2577 "parsing/parser.mly" ( let e = match oe with | None -> @@ -31338,13 +31341,13 @@ module Tables = struct e in label, e ) -# 31342 "parsing/parser.ml" +# 31345 "parsing/parser.ml" in -# 987 "parsing/parser.mly" +# 990 "parsing/parser.mly" ( x :: xs ) -# 31348 "parsing/parser.ml" +# 31351 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31369,12 +31372,12 @@ module Tables = struct let _v : (Parsetree.pattern list) = let _2 = # 124 "" ( None ) -# 31373 "parsing/parser.ml" +# 31376 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31378 "parsing/parser.ml" +# 31381 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31408,13 +31411,13 @@ module Tables = struct # 126 "" ( Some x ) -# 31412 "parsing/parser.ml" +# 31415 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31418 "parsing/parser.ml" +# 31421 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31451,9 +31454,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_xs_ in let _v : (Parsetree.pattern list) = -# 987 "parsing/parser.mly" +# 990 "parsing/parser.mly" ( x :: xs ) -# 31457 "parsing/parser.ml" +# 31460 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31492,7 +31495,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = # 124 "" ( None ) -# 31496 "parsing/parser.ml" +# 31499 "parsing/parser.ml" in let x = let label = @@ -31500,9 +31503,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31506 "parsing/parser.ml" +# 31509 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -31510,7 +31513,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2557 "parsing/parser.mly" +# 2560 "parsing/parser.mly" ( let e = match eo with | None -> @@ -31520,13 +31523,13 @@ module Tables = struct e in label, mkexp_opt_constraint ~loc:_sloc e c ) -# 31524 "parsing/parser.ml" +# 31527 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31530 "parsing/parser.ml" +# 31533 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31572,7 +31575,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = # 126 "" ( Some x ) -# 31576 "parsing/parser.ml" +# 31579 "parsing/parser.ml" in let x = let label = @@ -31580,9 +31583,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31586 "parsing/parser.ml" +# 31589 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -31590,7 +31593,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2557 "parsing/parser.mly" +# 2560 "parsing/parser.mly" ( let e = match eo with | None -> @@ -31600,13 +31603,13 @@ module Tables = struct e in label, mkexp_opt_constraint ~loc:_sloc e c ) -# 31604 "parsing/parser.ml" +# 31607 "parsing/parser.ml" in -# 983 "parsing/parser.mly" +# 986 "parsing/parser.mly" ( [x] ) -# 31610 "parsing/parser.ml" +# 31613 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31662,9 +31665,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31668 "parsing/parser.ml" +# 31671 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -31672,7 +31675,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2557 "parsing/parser.mly" +# 2560 "parsing/parser.mly" ( let e = match eo with | None -> @@ -31682,13 +31685,13 @@ module Tables = struct e in label, mkexp_opt_constraint ~loc:_sloc e c ) -# 31686 "parsing/parser.ml" +# 31689 "parsing/parser.ml" in -# 987 "parsing/parser.mly" +# 990 "parsing/parser.mly" ( x :: xs ) -# 31692 "parsing/parser.ml" +# 31695 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31711,9 +31714,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = -# 2073 "parsing/parser.mly" +# 2076 "parsing/parser.mly" ( _1 ) -# 31717 "parsing/parser.ml" +# 31720 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31743,9 +31746,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2074 "parsing/parser.mly" +# 2077 "parsing/parser.mly" ( _1 ) -# 31749 "parsing/parser.ml" +# 31752 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31783,24 +31786,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2076 "parsing/parser.mly" +# 2079 "parsing/parser.mly" ( Pexp_sequence(_1, _3) ) -# 31789 "parsing/parser.ml" +# 31792 "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" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 31798 "parsing/parser.ml" +# 31801 "parsing/parser.ml" in -# 2077 "parsing/parser.mly" +# 2080 "parsing/parser.mly" ( _1 ) -# 31804 "parsing/parser.ml" +# 31807 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31854,11 +31857,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2079 "parsing/parser.mly" +# 2082 "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)) ) -# 31862 "parsing/parser.ml" +# 31865 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31925,18 +31928,18 @@ module Tables = struct let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 31931 "parsing/parser.ml" +# 31934 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined4_ in let attrs2 = let _1 = _1_inlined3 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 31940 "parsing/parser.ml" +# 31943 "parsing/parser.ml" in let id = @@ -31945,31 +31948,31 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31951 "parsing/parser.ml" +# 31954 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 31959 "parsing/parser.ml" +# 31962 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3021 "parsing/parser.mly" +# 3024 "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 ) -# 31973 "parsing/parser.ml" +# 31976 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31995,21 +31998,21 @@ module Tables = struct let _1 = # 260 "" ( List.flatten xss ) -# 31999 "parsing/parser.ml" +# 32002 "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" +# 809 "parsing/parser.mly" ( extra_sig _startpos _endpos _1 ) -# 32007 "parsing/parser.ml" +# 32010 "parsing/parser.ml" in -# 1542 "parsing/parser.mly" +# 1545 "parsing/parser.mly" ( _1 ) -# 32013 "parsing/parser.ml" +# 32016 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32041,9 +32044,9 @@ module Tables = struct let _v : (Parsetree.signature_item) = let _2 = let _1 = _1_inlined1 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 32047 "parsing/parser.ml" +# 32050 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -32051,10 +32054,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1557 "parsing/parser.mly" +# 1560 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) ) -# 32058 "parsing/parser.ml" +# 32061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32078,63 +32081,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1561 "parsing/parser.mly" +# 1564 "parsing/parser.mly" ( Psig_attribute _1 ) -# 32084 "parsing/parser.ml" +# 32087 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 854 "parsing/parser.mly" +# 857 "parsing/parser.mly" ( mksig ~loc:_sloc _1 ) -# 32092 "parsing/parser.ml" +# 32095 "parsing/parser.ml" in -# 1563 "parsing/parser.mly" - ( _1 ) -# 32098 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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 ) -# 32124 "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 ) -# 32132 "parsing/parser.ml" - - in - -# 1596 "parsing/parser.mly" ( _1 ) -# 32138 "parsing/parser.ml" +# 32101 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32158,23 +32121,63 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1568 "parsing/parser.mly" +# 1569 "parsing/parser.mly" ( psig_value _1 ) -# 32164 "parsing/parser.ml" +# 32127 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32172 "parsing/parser.ml" +# 32135 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32178 "parsing/parser.ml" +# 32141 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 = +# 1571 "parsing/parser.mly" + ( psig_value _1 ) +# 32167 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 874 "parsing/parser.mly" + ( wrap_mksig_ext ~loc:_sloc _1 ) +# 32175 "parsing/parser.ml" + + in + +# 1599 "parsing/parser.mly" + ( _1 ) +# 32181 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32209,26 +32212,26 @@ module Tables = struct let _1 = let _1 = let _1 = -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 32215 "parsing/parser.ml" +# 32218 "parsing/parser.ml" in -# 2842 "parsing/parser.mly" +# 2845 "parsing/parser.mly" ( _1 ) -# 32220 "parsing/parser.ml" +# 32223 "parsing/parser.ml" in -# 2825 "parsing/parser.mly" +# 2828 "parsing/parser.mly" ( _1 ) -# 32226 "parsing/parser.ml" +# 32229 "parsing/parser.ml" in -# 1570 "parsing/parser.mly" +# 1573 "parsing/parser.mly" ( psig_type _1 ) -# 32232 "parsing/parser.ml" +# 32235 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -32236,15 +32239,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32242 "parsing/parser.ml" +# 32245 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32248 "parsing/parser.ml" +# 32251 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32279,26 +32282,26 @@ module Tables = struct let _1 = let _1 = let _1 = -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 32285 "parsing/parser.ml" +# 32288 "parsing/parser.ml" in -# 2842 "parsing/parser.mly" +# 2845 "parsing/parser.mly" ( _1 ) -# 32290 "parsing/parser.ml" +# 32293 "parsing/parser.ml" in -# 2830 "parsing/parser.mly" +# 2833 "parsing/parser.mly" ( _1 ) -# 32296 "parsing/parser.ml" +# 32299 "parsing/parser.ml" in -# 1572 "parsing/parser.mly" +# 1575 "parsing/parser.mly" ( psig_typesubst _1 ) -# 32302 "parsing/parser.ml" +# 32305 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -32306,15 +32309,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32312 "parsing/parser.ml" +# 32315 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32318 "parsing/parser.ml" +# 32321 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32399,16 +32402,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 32405 "parsing/parser.ml" +# 32408 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let cs = -# 1036 "parsing/parser.mly" +# 1039 "parsing/parser.mly" ( List.rev xs ) -# 32412 "parsing/parser.ml" +# 32415 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -32416,46 +32419,46 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32422 "parsing/parser.ml" +# 32425 "parsing/parser.ml" in let _4 = -# 3585 "parsing/parser.mly" +# 3588 "parsing/parser.mly" ( Recursive ) -# 32428 "parsing/parser.ml" +# 32431 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 32435 "parsing/parser.ml" +# 32438 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3090 "parsing/parser.mly" +# 3093 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 32447 "parsing/parser.ml" +# 32450 "parsing/parser.ml" in -# 3077 "parsing/parser.mly" +# 3080 "parsing/parser.mly" ( _1 ) -# 32453 "parsing/parser.ml" +# 32456 "parsing/parser.ml" in -# 1574 "parsing/parser.mly" +# 1577 "parsing/parser.mly" ( psig_typext _1 ) -# 32459 "parsing/parser.ml" +# 32462 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -32463,15 +32466,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32469 "parsing/parser.ml" +# 32472 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32475 "parsing/parser.ml" +# 32478 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32563,16 +32566,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 32569 "parsing/parser.ml" +# 32572 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in let cs = -# 1036 "parsing/parser.mly" +# 1039 "parsing/parser.mly" ( List.rev xs ) -# 32576 "parsing/parser.ml" +# 32579 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -32580,9 +32583,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32586 "parsing/parser.ml" +# 32589 "parsing/parser.ml" in let _4 = @@ -32591,41 +32594,41 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3586 "parsing/parser.mly" +# 3589 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 32597 "parsing/parser.ml" +# 32600 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 32605 "parsing/parser.ml" +# 32608 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3090 "parsing/parser.mly" +# 3093 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 32617 "parsing/parser.ml" +# 32620 "parsing/parser.ml" in -# 3077 "parsing/parser.mly" +# 3080 "parsing/parser.mly" ( _1 ) -# 32623 "parsing/parser.ml" +# 32626 "parsing/parser.ml" in -# 1574 "parsing/parser.mly" +# 1577 "parsing/parser.mly" ( psig_typext _1 ) -# 32629 "parsing/parser.ml" +# 32632 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -32633,15 +32636,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32639 "parsing/parser.ml" +# 32642 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32645 "parsing/parser.ml" +# 32648 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32665,23 +32668,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1576 "parsing/parser.mly" +# 1579 "parsing/parser.mly" ( psig_exception _1 ) -# 32671 "parsing/parser.ml" +# 32674 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32679 "parsing/parser.ml" +# 32682 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32685 "parsing/parser.ml" +# 32688 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32744,9 +32747,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 32750 "parsing/parser.ml" +# 32753 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -32756,37 +32759,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32762 "parsing/parser.ml" +# 32765 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 32770 "parsing/parser.ml" +# 32773 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1605 "parsing/parser.mly" +# 1608 "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 ) -# 32784 "parsing/parser.ml" +# 32787 "parsing/parser.ml" in -# 1578 "parsing/parser.mly" +# 1581 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_module body, ext) ) -# 32790 "parsing/parser.ml" +# 32793 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -32794,15 +32797,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32800 "parsing/parser.ml" +# 32803 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32806 "parsing/parser.ml" +# 32809 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32872,9 +32875,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 32878 "parsing/parser.ml" +# 32881 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -32885,9 +32888,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32891 "parsing/parser.ml" +# 32894 "parsing/parser.ml" in let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in @@ -32895,9 +32898,9 @@ module Tables = struct let _symbolstartpos = _startpos_id_ in let _sloc = (_symbolstartpos, _endpos) in -# 1641 "parsing/parser.mly" +# 1644 "parsing/parser.mly" ( Mty.alias ~loc:(make_loc _sloc) id ) -# 32901 "parsing/parser.ml" +# 32904 "parsing/parser.ml" in let name = @@ -32906,37 +32909,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32912 "parsing/parser.ml" +# 32915 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 32920 "parsing/parser.ml" +# 32923 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1632 "parsing/parser.mly" +# 1635 "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 ) -# 32934 "parsing/parser.ml" +# 32937 "parsing/parser.ml" in -# 1580 "parsing/parser.mly" +# 1583 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_module body, ext) ) -# 32940 "parsing/parser.ml" +# 32943 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -32944,15 +32947,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32950 "parsing/parser.ml" +# 32953 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32956 "parsing/parser.ml" +# 32959 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32976,23 +32979,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1582 "parsing/parser.mly" +# 1585 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modsubst body, ext) ) -# 32982 "parsing/parser.ml" +# 32985 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32990 "parsing/parser.ml" +# 32993 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 32996 "parsing/parser.ml" +# 32999 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33078,9 +33081,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 33084 "parsing/parser.ml" +# 33087 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -33090,49 +33093,49 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 33096 "parsing/parser.ml" +# 33099 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 33104 "parsing/parser.ml" +# 33107 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1675 "parsing/parser.mly" +# 1678 "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 ) -# 33118 "parsing/parser.ml" +# 33121 "parsing/parser.ml" in -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 33124 "parsing/parser.ml" +# 33127 "parsing/parser.ml" in -# 1664 "parsing/parser.mly" +# 1667 "parsing/parser.mly" ( _1 ) -# 33130 "parsing/parser.ml" +# 33133 "parsing/parser.ml" in -# 1584 "parsing/parser.mly" +# 1587 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_recmodule l, ext) ) -# 33136 "parsing/parser.ml" +# 33139 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -33140,15 +33143,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 33146 "parsing/parser.ml" +# 33149 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 33152 "parsing/parser.ml" +# 33155 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33172,23 +33175,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1586 "parsing/parser.mly" +# 1589 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modtype body, ext) ) -# 33178 "parsing/parser.ml" +# 33181 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 33186 "parsing/parser.ml" +# 33189 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 33192 "parsing/parser.ml" +# 33195 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33212,23 +33215,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1588 "parsing/parser.mly" +# 1591 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_open body, ext) ) -# 33218 "parsing/parser.ml" +# 33221 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 33226 "parsing/parser.ml" +# 33229 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 33232 "parsing/parser.ml" +# 33235 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33284,38 +33287,38 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 33290 "parsing/parser.ml" +# 33293 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 33299 "parsing/parser.ml" +# 33302 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1434 "parsing/parser.mly" +# 1437 "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 ) -# 33313 "parsing/parser.ml" +# 33316 "parsing/parser.ml" in -# 1590 "parsing/parser.mly" +# 1593 "parsing/parser.mly" ( psig_include _1 ) -# 33319 "parsing/parser.ml" +# 33322 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined2_ in @@ -33323,15 +33326,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 33329 "parsing/parser.ml" +# 33332 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 33335 "parsing/parser.ml" +# 33338 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33408,9 +33411,9 @@ module Tables = struct let cty : (Parsetree.class_type) = Obj.magic cty in let _7 : unit = Obj.magic _7 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 33414 "parsing/parser.ml" +# 33417 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -33428,9 +33431,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 33434 "parsing/parser.ml" +# 33437 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -33440,24 +33443,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 33446 "parsing/parser.ml" +# 33449 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 33454 "parsing/parser.ml" +# 33457 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2005 "parsing/parser.mly" +# 2008 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -33465,25 +33468,25 @@ module Tables = struct ext, Ci.mk id cty ~virt ~params ~attrs ~loc ~docs ) -# 33469 "parsing/parser.ml" +# 33472 "parsing/parser.ml" in -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 33475 "parsing/parser.ml" +# 33478 "parsing/parser.ml" in -# 1993 "parsing/parser.mly" +# 1996 "parsing/parser.mly" ( _1 ) -# 33481 "parsing/parser.ml" +# 33484 "parsing/parser.ml" in -# 1592 "parsing/parser.mly" +# 1595 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_class l, ext) ) -# 33487 "parsing/parser.ml" +# 33490 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -33491,15 +33494,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 33497 "parsing/parser.ml" +# 33500 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 33503 "parsing/parser.ml" +# 33506 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33523,23 +33526,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1594 "parsing/parser.mly" +# 1597 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_class_type l, ext) ) -# 33529 "parsing/parser.ml" +# 33532 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 871 "parsing/parser.mly" +# 874 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 33537 "parsing/parser.ml" +# 33540 "parsing/parser.ml" in -# 1596 "parsing/parser.mly" +# 1599 "parsing/parser.mly" ( _1 ) -# 33543 "parsing/parser.ml" +# 33546 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33562,117 +33565,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constant) = -# 3416 "parsing/parser.mly" - ( _1 ) -# 33568 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 33595 "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) = -# 3417 "parsing/parser.mly" - ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) ) -# 33604 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 33631 "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) = -# 3418 "parsing/parser.mly" - ( let (f, m) = _2 in Pconst_float("-" ^ f, m) ) -# 33640 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 33667 "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) = # 3419 "parsing/parser.mly" - ( let (n, m) = _2 in Pconst_integer (n, m) ) -# 33676 "parsing/parser.ml" + ( _1 ) +# 33571 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33697,9 +33592,9 @@ module Tables = struct }; } = _menhir_stack in let _2 : ( -# 612 "parsing/parser.mly" +# 636 "parsing/parser.mly" (string * char option) -# 33703 "parsing/parser.ml" +# 33598 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -33707,8 +33602,116 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.constant) = # 3420 "parsing/parser.mly" + ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) ) +# 33607 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 615 "parsing/parser.mly" + (string * char option) +# 33634 "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) = +# 3421 "parsing/parser.mly" + ( let (f, m) = _2 in Pconst_float("-" ^ f, m) ) +# 33643 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 636 "parsing/parser.mly" + (string * char option) +# 33670 "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) = +# 3422 "parsing/parser.mly" + ( let (n, m) = _2 in Pconst_integer (n, m) ) +# 33679 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 615 "parsing/parser.mly" + (string * char option) +# 33706 "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) = +# 3423 "parsing/parser.mly" ( let (f, m) = _2 in Pconst_float(f, m) ) -# 33712 "parsing/parser.ml" +# 33715 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33749,87 +33752,18 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 2757 "parsing/parser.mly" +# 2760 "parsing/parser.mly" ( let fields, closed = _1 in let closed = match closed with Some () -> Open | None -> Closed in fields, closed ) -# 33757 "parsing/parser.ml" +# 33760 "parsing/parser.ml" in -# 2728 "parsing/parser.mly" - ( let (fields, closed) = _2 in - Ppat_record(fields, closed) ) -# 33764 "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 ) -# 33774 "parsing/parser.ml" - - in - -# 2742 "parsing/parser.mly" - ( _1 ) -# 33780 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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 ) -# 33825 "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_ ) -# 33833 "parsing/parser.ml" + ( let (fields, closed) = _2 in + Ppat_record(fields, closed) ) +# 33767 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33837,15 +33771,84 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33843 "parsing/parser.ml" +# 33777 "parsing/parser.ml" in -# 2742 "parsing/parser.mly" +# 2745 "parsing/parser.mly" ( _1 ) -# 33849 "parsing/parser.ml" +# 33783 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 + +# 2760 "parsing/parser.mly" + ( let fields, closed = _1 in + let closed = match closed with Some () -> Open | None -> Closed in + fields, closed ) +# 33828 "parsing/parser.ml" + + in + let _loc__3_ = (_startpos__3_, _endpos__3_) in + let _loc__1_ = (_startpos__1_, _endpos__1_) in + +# 2734 "parsing/parser.mly" + ( unclosed "{" _loc__1_ "}" _loc__3_ ) +# 33836 "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 + +# 851 "parsing/parser.mly" + ( mkpat ~loc:_sloc _1 ) +# 33846 "parsing/parser.ml" + + in + +# 2745 "parsing/parser.mly" + ( _1 ) +# 33852 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33884,15 +33887,15 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2751 "parsing/parser.mly" +# 2754 "parsing/parser.mly" ( ps ) -# 33890 "parsing/parser.ml" +# 33893 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2733 "parsing/parser.mly" +# 2736 "parsing/parser.mly" ( fst (mktailpat _loc__3_ _2) ) -# 33896 "parsing/parser.ml" +# 33899 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33900,15 +33903,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33906 "parsing/parser.ml" +# 33909 "parsing/parser.ml" in -# 2742 "parsing/parser.mly" +# 2745 "parsing/parser.mly" ( _1 ) -# 33912 "parsing/parser.ml" +# 33915 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33947,16 +33950,16 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2751 "parsing/parser.mly" +# 2754 "parsing/parser.mly" ( ps ) -# 33953 "parsing/parser.ml" +# 33956 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2735 "parsing/parser.mly" +# 2738 "parsing/parser.mly" ( unclosed "[" _loc__1_ "]" _loc__3_ ) -# 33960 "parsing/parser.ml" +# 33963 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33964,15 +33967,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33970 "parsing/parser.ml" +# 33973 "parsing/parser.ml" in -# 2742 "parsing/parser.mly" +# 2745 "parsing/parser.mly" ( _1 ) -# 33976 "parsing/parser.ml" +# 33979 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34011,14 +34014,14 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2751 "parsing/parser.mly" +# 2754 "parsing/parser.mly" ( ps ) -# 34017 "parsing/parser.ml" +# 34020 "parsing/parser.ml" in -# 2737 "parsing/parser.mly" +# 2740 "parsing/parser.mly" ( Ppat_array _2 ) -# 34022 "parsing/parser.ml" +# 34025 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -34026,15 +34029,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 34032 "parsing/parser.ml" +# 34035 "parsing/parser.ml" in -# 2742 "parsing/parser.mly" +# 2745 "parsing/parser.mly" ( _1 ) -# 34038 "parsing/parser.ml" +# 34041 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34065,24 +34068,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2739 "parsing/parser.mly" +# 2742 "parsing/parser.mly" ( Ppat_array [] ) -# 34071 "parsing/parser.ml" +# 34074 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 34080 "parsing/parser.ml" +# 34083 "parsing/parser.ml" in -# 2742 "parsing/parser.mly" +# 2745 "parsing/parser.mly" ( _1 ) -# 34086 "parsing/parser.ml" +# 34089 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34121,16 +34124,16 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2751 "parsing/parser.mly" +# 2754 "parsing/parser.mly" ( ps ) -# 34127 "parsing/parser.ml" +# 34130 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2741 "parsing/parser.mly" +# 2744 "parsing/parser.mly" ( unclosed "[|" _loc__1_ "|]" _loc__3_ ) -# 34134 "parsing/parser.ml" +# 34137 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -34138,15 +34141,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 34144 "parsing/parser.ml" +# 34147 "parsing/parser.ml" in -# 2742 "parsing/parser.mly" +# 2745 "parsing/parser.mly" ( _1 ) -# 34150 "parsing/parser.ml" +# 34153 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34186,9 +34189,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2240 "parsing/parser.mly" +# 2243 "parsing/parser.mly" ( reloc_exp ~loc:_sloc _2 ) -# 34192 "parsing/parser.ml" +# 34195 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34227,9 +34230,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2242 "parsing/parser.mly" +# 2245 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 34233 "parsing/parser.ml" +# 34236 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34276,9 +34279,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2244 "parsing/parser.mly" +# 2247 "parsing/parser.mly" ( mkexp_constraint ~loc:_sloc _2 _3 ) -# 34282 "parsing/parser.ml" +# 34285 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34332,9 +34335,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2246 "parsing/parser.mly" +# 2249 "parsing/parser.mly" ( array_get ~loc:_sloc _1 _4 ) -# 34338 "parsing/parser.ml" +# 34341 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34387,9 +34390,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2248 "parsing/parser.mly" +# 2251 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 34393 "parsing/parser.ml" +# 34396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34443,9 +34446,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2250 "parsing/parser.mly" +# 2253 "parsing/parser.mly" ( string_get ~loc:_sloc _1 _4 ) -# 34449 "parsing/parser.ml" +# 34452 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34498,9 +34501,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2252 "parsing/parser.mly" +# 2255 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 34504 "parsing/parser.ml" +# 34507 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34546,26 +34549,26 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34552 "parsing/parser.ml" +# 34555 "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" +# 2589 "parsing/parser.mly" ( es ) -# 34561 "parsing/parser.ml" +# 34564 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2254 "parsing/parser.mly" +# 2257 "parsing/parser.mly" ( dotop_get ~loc:_sloc lident bracket _2 _1 _4 ) -# 34569 "parsing/parser.ml" +# 34572 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34611,25 +34614,25 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34617 "parsing/parser.ml" +# 34620 "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" +# 2589 "parsing/parser.mly" ( es ) -# 34626 "parsing/parser.ml" +# 34629 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2256 "parsing/parser.mly" +# 2259 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 34633 "parsing/parser.ml" +# 34636 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34675,26 +34678,26 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34681 "parsing/parser.ml" +# 34684 "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" +# 2589 "parsing/parser.mly" ( es ) -# 34690 "parsing/parser.ml" +# 34693 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2258 "parsing/parser.mly" +# 2261 "parsing/parser.mly" ( dotop_get ~loc:_sloc lident paren _2 _1 _4 ) -# 34698 "parsing/parser.ml" +# 34701 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34740,25 +34743,25 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34746 "parsing/parser.ml" +# 34749 "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" +# 2589 "parsing/parser.mly" ( es ) -# 34755 "parsing/parser.ml" +# 34758 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2260 "parsing/parser.mly" +# 2263 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 34762 "parsing/parser.ml" +# 34765 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34804,26 +34807,26 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34810 "parsing/parser.ml" +# 34813 "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" +# 2589 "parsing/parser.mly" ( es ) -# 34819 "parsing/parser.ml" +# 34822 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2262 "parsing/parser.mly" +# 2265 "parsing/parser.mly" ( dotop_get ~loc:_sloc lident brace _2 _1 _4 ) -# 34827 "parsing/parser.ml" +# 34830 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34869,9 +34872,9 @@ module Tables = struct let _4 : (Parsetree.expression) = Obj.magic _4 in let _3 : unit = Obj.magic _3 in let _2 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34875 "parsing/parser.ml" +# 34878 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -34880,9 +34883,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2264 "parsing/parser.mly" +# 2267 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 34886 "parsing/parser.ml" +# 34889 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34940,9 +34943,9 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 34946 "parsing/parser.ml" +# 34949 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34951,95 +34954,17 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in let _v : (Parsetree.expression) = let _6 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 34957 "parsing/parser.ml" +# 34960 "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 ) -# 34965 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 35025 "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 ) -# 35036 "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_ ) -# 35043 "parsing/parser.ml" + ( dotop_get ~loc:_sloc (ldot _3) bracket _4 _1 _6 ) +# 34968 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35097,9 +35022,9 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 35103 "parsing/parser.ml" +# 35028 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -35108,95 +35033,95 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in let _v : (Parsetree.expression) = let _6 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 35114 "parsing/parser.ml" +# 35039 "parsing/parser.ml" + in + let _loc__7_ = (_startpos__7_, _endpos__7_) in + let _loc__5_ = (_startpos__5_, _endpos__5_) in + +# 2272 "parsing/parser.mly" + ( unclosed "[" _loc__5_ "]" _loc__7_ ) +# 35046 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 35106 "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 = +# 2589 "parsing/parser.mly" + ( es ) +# 35117 "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 ) -# 35122 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 35182 "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 ) -# 35193 "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_ ) -# 35200 "parsing/parser.ml" + ( dotop_get ~loc:_sloc (ldot _3) paren _4 _1 _6 ) +# 35125 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35254,9 +35179,9 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 35260 "parsing/parser.ml" +# 35185 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -35265,17 +35190,95 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in let _v : (Parsetree.expression) = let _6 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 35271 "parsing/parser.ml" +# 35196 "parsing/parser.ml" + in + let _loc__7_ = (_startpos__7_, _endpos__7_) in + let _loc__5_ = (_startpos__5_, _endpos__5_) in + +# 2277 "parsing/parser.mly" + ( unclosed "(" _loc__5_ ")" _loc__7_ ) +# 35203 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 : ( +# 631 "parsing/parser.mly" + (string) +# 35263 "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 = +# 2589 "parsing/parser.mly" + ( es ) +# 35274 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2276 "parsing/parser.mly" +# 2279 "parsing/parser.mly" ( dotop_get ~loc:_sloc (ldot _3) brace _4 _1 _6 ) -# 35279 "parsing/parser.ml" +# 35282 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35333,9 +35336,9 @@ module Tables = struct let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 628 "parsing/parser.mly" +# 631 "parsing/parser.mly" (string) -# 35339 "parsing/parser.ml" +# 35342 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -35344,16 +35347,16 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in let _v : (Parsetree.expression) = let _6 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 35350 "parsing/parser.ml" +# 35353 "parsing/parser.ml" in let _loc__7_ = (_startpos__7_, _endpos__7_) in let _loc__5_ = (_startpos__5_, _endpos__5_) in -# 2279 "parsing/parser.mly" +# 2282 "parsing/parser.mly" ( unclosed "{" _loc__5_ "}" _loc__7_ ) -# 35357 "parsing/parser.ml" +# 35360 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35407,9 +35410,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2281 "parsing/parser.mly" +# 2284 "parsing/parser.mly" ( bigarray_get ~loc:_sloc _1 _4 ) -# 35413 "parsing/parser.ml" +# 35416 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35462,9 +35465,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2283 "parsing/parser.mly" +# 2286 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 35468 "parsing/parser.ml" +# 35471 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35518,15 +35521,15 @@ module Tables = struct let attrs = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 35524 "parsing/parser.ml" +# 35527 "parsing/parser.ml" in -# 2292 "parsing/parser.mly" +# 2295 "parsing/parser.mly" ( e.pexp_desc, (ext, attrs @ e.pexp_attributes) ) -# 35530 "parsing/parser.ml" +# 35533 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -35534,10 +35537,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35541 "parsing/parser.ml" +# 35544 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35586,24 +35589,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 35592 "parsing/parser.ml" +# 35595 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 35598 "parsing/parser.ml" +# 35601 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2294 "parsing/parser.mly" +# 2297 "parsing/parser.mly" ( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 ) -# 35607 "parsing/parser.ml" +# 35610 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -35611,10 +35614,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35618 "parsing/parser.ml" +# 35621 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35670,23 +35673,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 35676 "parsing/parser.ml" +# 35679 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 35682 "parsing/parser.ml" +# 35685 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2296 "parsing/parser.mly" +# 2299 "parsing/parser.mly" ( unclosed "begin" _loc__1_ "end" _loc__4_ ) -# 35690 "parsing/parser.ml" +# 35693 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -35694,10 +35697,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35701 "parsing/parser.ml" +# 35704 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35747,9 +35750,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 35753 "parsing/parser.ml" +# 35756 "parsing/parser.ml" in let _2 = @@ -35757,21 +35760,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 35763 "parsing/parser.ml" +# 35766 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 35769 "parsing/parser.ml" +# 35772 "parsing/parser.ml" in -# 2298 "parsing/parser.mly" +# 2301 "parsing/parser.mly" ( Pexp_new(_3), _2 ) -# 35775 "parsing/parser.ml" +# 35778 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -35779,10 +35782,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35786 "parsing/parser.ml" +# 35789 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35845,21 +35848,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 35851 "parsing/parser.ml" +# 35854 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 35857 "parsing/parser.ml" +# 35860 "parsing/parser.ml" in -# 2300 "parsing/parser.mly" +# 2303 "parsing/parser.mly" ( Pexp_pack _4, _3 ) -# 35863 "parsing/parser.ml" +# 35866 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -35867,10 +35870,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35874 "parsing/parser.ml" +# 35877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35948,11 +35951,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 35956 "parsing/parser.ml" +# 35959 "parsing/parser.ml" in let _3 = @@ -35960,24 +35963,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 35966 "parsing/parser.ml" +# 35969 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 35972 "parsing/parser.ml" +# 35975 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2302 "parsing/parser.mly" +# 2305 "parsing/parser.mly" ( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 ) -# 35981 "parsing/parser.ml" +# 35984 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -35985,10 +35988,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35992 "parsing/parser.ml" +# 35995 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36058,23 +36061,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 36064 "parsing/parser.ml" +# 36067 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 36070 "parsing/parser.ml" +# 36073 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2304 "parsing/parser.mly" +# 2307 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 36078 "parsing/parser.ml" +# 36081 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -36082,10 +36085,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2285 "parsing/parser.mly" +# 2288 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 36089 "parsing/parser.ml" +# 36092 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36114,30 +36117,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36120 "parsing/parser.ml" +# 36123 "parsing/parser.ml" in -# 2308 "parsing/parser.mly" +# 2311 "parsing/parser.mly" ( Pexp_ident (_1) ) -# 36126 "parsing/parser.ml" +# 36129 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36135 "parsing/parser.ml" +# 36138 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36141 "parsing/parser.ml" +# 36144 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36161,23 +36164,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2310 "parsing/parser.mly" +# 2313 "parsing/parser.mly" ( Pexp_constant _1 ) -# 36167 "parsing/parser.ml" +# 36170 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36175 "parsing/parser.ml" +# 36178 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36181 "parsing/parser.ml" +# 36184 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36206,30 +36209,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36212 "parsing/parser.ml" +# 36215 "parsing/parser.ml" in -# 2312 "parsing/parser.mly" +# 2315 "parsing/parser.mly" ( Pexp_construct(_1, None) ) -# 36218 "parsing/parser.ml" +# 36221 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36227 "parsing/parser.ml" +# 36230 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36233 "parsing/parser.ml" +# 36236 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36253,23 +36256,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2314 "parsing/parser.mly" +# 2317 "parsing/parser.mly" ( Pexp_variant(_1, None) ) -# 36259 "parsing/parser.ml" +# 36262 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36267 "parsing/parser.ml" +# 36270 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36273 "parsing/parser.ml" +# 36276 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36295,9 +36298,9 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.expression) = Obj.magic _2 in let _1 : ( -# 671 "parsing/parser.mly" +# 674 "parsing/parser.mly" (string) -# 36301 "parsing/parser.ml" +# 36304 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -36309,15 +36312,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 36315 "parsing/parser.ml" +# 36318 "parsing/parser.ml" in -# 2316 "parsing/parser.mly" +# 2319 "parsing/parser.mly" ( Pexp_apply(_1, [Nolabel,_2]) ) -# 36321 "parsing/parser.ml" +# 36324 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -36325,15 +36328,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36331 "parsing/parser.ml" +# 36334 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36337 "parsing/parser.ml" +# 36340 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36366,23 +36369,23 @@ module Tables = struct let _1 = let _1 = let _1 = -# 2317 "parsing/parser.mly" +# 2320 "parsing/parser.mly" ("!") -# 36372 "parsing/parser.ml" +# 36375 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 36380 "parsing/parser.ml" +# 36383 "parsing/parser.ml" in -# 2318 "parsing/parser.mly" +# 2321 "parsing/parser.mly" ( Pexp_apply(_1, [Nolabel,_2]) ) -# 36386 "parsing/parser.ml" +# 36389 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -36390,15 +36393,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36396 "parsing/parser.ml" +# 36399 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36402 "parsing/parser.ml" +# 36405 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36437,14 +36440,14 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2569 "parsing/parser.mly" +# 2572 "parsing/parser.mly" ( xs ) -# 36443 "parsing/parser.ml" +# 36446 "parsing/parser.ml" in -# 2320 "parsing/parser.mly" +# 2323 "parsing/parser.mly" ( Pexp_override _2 ) -# 36448 "parsing/parser.ml" +# 36451 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36452,15 +36455,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36458 "parsing/parser.ml" +# 36461 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36464 "parsing/parser.ml" +# 36467 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36499,16 +36502,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2569 "parsing/parser.mly" +# 2572 "parsing/parser.mly" ( xs ) -# 36505 "parsing/parser.ml" +# 36508 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2322 "parsing/parser.mly" +# 2325 "parsing/parser.mly" ( unclosed "{<" _loc__1_ ">}" _loc__3_ ) -# 36512 "parsing/parser.ml" +# 36515 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36516,15 +36519,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36522 "parsing/parser.ml" +# 36525 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36528 "parsing/parser.ml" +# 36531 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36555,24 +36558,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2324 "parsing/parser.mly" +# 2327 "parsing/parser.mly" ( Pexp_override [] ) -# 36561 "parsing/parser.ml" +# 36564 "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" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36570 "parsing/parser.ml" +# 36573 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36576 "parsing/parser.ml" +# 36579 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36616,15 +36619,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36622 "parsing/parser.ml" +# 36625 "parsing/parser.ml" in -# 2326 "parsing/parser.mly" +# 2329 "parsing/parser.mly" ( Pexp_field(_1, _3) ) -# 36628 "parsing/parser.ml" +# 36631 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -36632,15 +36635,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36638 "parsing/parser.ml" +# 36641 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36644 "parsing/parser.ml" +# 36647 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36698,24 +36701,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36704 "parsing/parser.ml" +# 36707 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 36713 "parsing/parser.ml" +# 36716 "parsing/parser.ml" in -# 2328 "parsing/parser.mly" +# 2331 "parsing/parser.mly" ( Pexp_open(od, _4) ) -# 36719 "parsing/parser.ml" +# 36722 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36723,15 +36726,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36729 "parsing/parser.ml" +# 36732 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36735 "parsing/parser.ml" +# 36738 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36784,9 +36787,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2569 "parsing/parser.mly" +# 2572 "parsing/parser.mly" ( xs ) -# 36790 "parsing/parser.ml" +# 36793 "parsing/parser.ml" in let od = let _1 = @@ -36794,18 +36797,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36800 "parsing/parser.ml" +# 36803 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 36809 "parsing/parser.ml" +# 36812 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -36813,10 +36816,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2330 "parsing/parser.mly" +# 2333 "parsing/parser.mly" ( (* TODO: review the location of Pexp_override *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) ) -# 36820 "parsing/parser.ml" +# 36823 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36824,15 +36827,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36830 "parsing/parser.ml" +# 36833 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36836 "parsing/parser.ml" +# 36839 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36885,16 +36888,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2569 "parsing/parser.mly" +# 2572 "parsing/parser.mly" ( xs ) -# 36891 "parsing/parser.ml" +# 36894 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2333 "parsing/parser.mly" +# 2336 "parsing/parser.mly" ( unclosed "{<" _loc__3_ ">}" _loc__5_ ) -# 36898 "parsing/parser.ml" +# 36901 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36902,15 +36905,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36908 "parsing/parser.ml" +# 36911 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36914 "parsing/parser.ml" +# 36917 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36941,9 +36944,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 36947 "parsing/parser.ml" +# 36950 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in @@ -36955,23 +36958,23 @@ module Tables = struct let _3 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 36961 "parsing/parser.ml" +# 36964 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36969 "parsing/parser.ml" +# 36972 "parsing/parser.ml" in -# 2335 "parsing/parser.mly" +# 2338 "parsing/parser.mly" ( Pexp_send(_1, _3) ) -# 36975 "parsing/parser.ml" +# 36978 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -36979,15 +36982,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36985 "parsing/parser.ml" +# 36988 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 36991 "parsing/parser.ml" +# 36994 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37019,9 +37022,9 @@ module Tables = struct } = _menhir_stack in let _3 : (Parsetree.expression) = Obj.magic _3 in let _1_inlined1 : ( -# 682 "parsing/parser.mly" +# 685 "parsing/parser.mly" (string) -# 37025 "parsing/parser.ml" +# 37028 "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 @@ -37035,15 +37038,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 840 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 37041 "parsing/parser.ml" +# 37044 "parsing/parser.ml" in -# 2337 "parsing/parser.mly" +# 2340 "parsing/parser.mly" ( mkinfix _1 _2 _3 ) -# 37047 "parsing/parser.ml" +# 37050 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37051,15 +37054,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37057 "parsing/parser.ml" +# 37060 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37063 "parsing/parser.ml" +# 37066 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37083,23 +37086,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2339 "parsing/parser.mly" +# 2342 "parsing/parser.mly" ( Pexp_extension _1 ) -# 37089 "parsing/parser.ml" +# 37092 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37097 "parsing/parser.ml" +# 37100 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37103 "parsing/parser.ml" +# 37106 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37147,18 +37150,18 @@ module Tables = struct 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" +# 2343 "parsing/parser.mly" (Lident "()") -# 37153 "parsing/parser.ml" +# 37156 "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" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37162 "parsing/parser.ml" +# 37165 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -37168,18 +37171,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37174 "parsing/parser.ml" +# 37177 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37183 "parsing/parser.ml" +# 37186 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37187,10 +37190,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2341 "parsing/parser.mly" +# 2344 "parsing/parser.mly" ( (* TODO: review the location of Pexp_construct *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) ) -# 37194 "parsing/parser.ml" +# 37197 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -37198,15 +37201,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37204 "parsing/parser.ml" +# 37207 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37210 "parsing/parser.ml" +# 37213 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37261,9 +37264,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2344 "parsing/parser.mly" +# 2347 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 37267 "parsing/parser.ml" +# 37270 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37271,15 +37274,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37277 "parsing/parser.ml" +# 37280 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37283 "parsing/parser.ml" +# 37286 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37318,25 +37321,25 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2346 "parsing/parser.mly" +# 2349 "parsing/parser.mly" ( let (exten, fields) = _2 in Pexp_record(fields, exten) ) -# 37325 "parsing/parser.ml" +# 37328 "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" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37334 "parsing/parser.ml" +# 37337 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37340 "parsing/parser.ml" +# 37343 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37378,9 +37381,9 @@ module Tables = struct let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2349 "parsing/parser.mly" +# 2352 "parsing/parser.mly" ( unclosed "{" _loc__1_ "}" _loc__3_ ) -# 37384 "parsing/parser.ml" +# 37387 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37388,15 +37391,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37394 "parsing/parser.ml" +# 37397 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37400 "parsing/parser.ml" +# 37403 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37455,18 +37458,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37461 "parsing/parser.ml" +# 37464 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37470 "parsing/parser.ml" +# 37473 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37474,11 +37477,11 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2351 "parsing/parser.mly" +# 2354 "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))) ) -# 37482 "parsing/parser.ml" +# 37485 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37486,15 +37489,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37492 "parsing/parser.ml" +# 37495 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37498 "parsing/parser.ml" +# 37501 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37550,9 +37553,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2355 "parsing/parser.mly" +# 2358 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 37556 "parsing/parser.ml" +# 37559 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37560,15 +37563,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37566 "parsing/parser.ml" +# 37569 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37572 "parsing/parser.ml" +# 37575 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37607,14 +37610,14 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 37613 "parsing/parser.ml" +# 37616 "parsing/parser.ml" in -# 2357 "parsing/parser.mly" +# 2360 "parsing/parser.mly" ( Pexp_array(_2) ) -# 37618 "parsing/parser.ml" +# 37621 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37622,15 +37625,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37628 "parsing/parser.ml" +# 37631 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37634 "parsing/parser.ml" +# 37637 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37669,16 +37672,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 37675 "parsing/parser.ml" +# 37678 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2359 "parsing/parser.mly" +# 2362 "parsing/parser.mly" ( unclosed "[|" _loc__1_ "|]" _loc__3_ ) -# 37682 "parsing/parser.ml" +# 37685 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37686,15 +37689,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37692 "parsing/parser.ml" +# 37695 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37698 "parsing/parser.ml" +# 37701 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37725,24 +37728,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2361 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( Pexp_array [] ) -# 37731 "parsing/parser.ml" +# 37734 "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" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37740 "parsing/parser.ml" +# 37743 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37746 "parsing/parser.ml" +# 37749 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37795,9 +37798,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 37801 "parsing/parser.ml" +# 37804 "parsing/parser.ml" in let od = let _1 = @@ -37805,18 +37808,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37811 "parsing/parser.ml" +# 37814 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37820 "parsing/parser.ml" +# 37823 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37824,10 +37827,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2363 "parsing/parser.mly" +# 2366 "parsing/parser.mly" ( (* TODO: review the location of Pexp_array *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_array(_4))) ) -# 37831 "parsing/parser.ml" +# 37834 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37835,15 +37838,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37841 "parsing/parser.ml" +# 37844 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37847 "parsing/parser.ml" +# 37850 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37894,18 +37897,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37900 "parsing/parser.ml" +# 37903 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37909 "parsing/parser.ml" +# 37912 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37913,10 +37916,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2366 "parsing/parser.mly" +# 2369 "parsing/parser.mly" ( (* TODO: review the location of Pexp_array *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_array [])) ) -# 37920 "parsing/parser.ml" +# 37923 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -37924,15 +37927,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37930 "parsing/parser.ml" +# 37933 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 37936 "parsing/parser.ml" +# 37939 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37985,16 +37988,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 37991 "parsing/parser.ml" +# 37994 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2370 "parsing/parser.mly" +# 2373 "parsing/parser.mly" ( unclosed "[|" _loc__3_ "|]" _loc__5_ ) -# 37998 "parsing/parser.ml" +# 38001 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -38002,15 +38005,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38008 "parsing/parser.ml" +# 38011 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38014 "parsing/parser.ml" +# 38017 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38049,15 +38052,15 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 38055 "parsing/parser.ml" +# 38058 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2372 "parsing/parser.mly" +# 2375 "parsing/parser.mly" ( fst (mktailexp _loc__3_ _2) ) -# 38061 "parsing/parser.ml" +# 38064 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -38065,15 +38068,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38071 "parsing/parser.ml" +# 38074 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38077 "parsing/parser.ml" +# 38080 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38112,16 +38115,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 38118 "parsing/parser.ml" +# 38121 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2374 "parsing/parser.mly" +# 2377 "parsing/parser.mly" ( unclosed "[" _loc__1_ "]" _loc__3_ ) -# 38125 "parsing/parser.ml" +# 38128 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -38129,15 +38132,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38135 "parsing/parser.ml" +# 38138 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38141 "parsing/parser.ml" +# 38144 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38190,9 +38193,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 38196 "parsing/parser.ml" +# 38199 "parsing/parser.ml" in let od = let _1 = @@ -38200,18 +38203,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38206 "parsing/parser.ml" +# 38209 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 38215 "parsing/parser.ml" +# 38218 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -38220,13 +38223,13 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _sloc = (_symbolstartpos, _endpos) in -# 2376 "parsing/parser.mly" +# 2379 "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) ) -# 38230 "parsing/parser.ml" +# 38233 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -38234,15 +38237,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38240 "parsing/parser.ml" +# 38243 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38246 "parsing/parser.ml" +# 38249 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38290,18 +38293,18 @@ module Tables = struct 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" +# 2384 "parsing/parser.mly" (Lident "[]") -# 38296 "parsing/parser.ml" +# 38299 "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" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38305 "parsing/parser.ml" +# 38308 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -38311,18 +38314,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38317 "parsing/parser.ml" +# 38320 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 38326 "parsing/parser.ml" +# 38329 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -38330,10 +38333,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2382 "parsing/parser.mly" +# 2385 "parsing/parser.mly" ( (* TODO: review the location of Pexp_construct *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) ) -# 38337 "parsing/parser.ml" +# 38340 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -38341,15 +38344,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38347 "parsing/parser.ml" +# 38350 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38353 "parsing/parser.ml" +# 38356 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38402,16 +38405,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2586 "parsing/parser.mly" +# 2589 "parsing/parser.mly" ( es ) -# 38408 "parsing/parser.ml" +# 38411 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2386 "parsing/parser.mly" +# 2389 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 38415 "parsing/parser.ml" +# 38418 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -38419,15 +38422,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38425 "parsing/parser.ml" +# 38428 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38431 "parsing/parser.ml" +# 38434 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38520,11 +38523,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 38528 "parsing/parser.ml" +# 38531 "parsing/parser.ml" in let _5 = @@ -38532,15 +38535,15 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 38538 "parsing/parser.ml" +# 38541 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 38544 "parsing/parser.ml" +# 38547 "parsing/parser.ml" in let od = @@ -38549,18 +38552,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38555 "parsing/parser.ml" +# 38558 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1493 "parsing/parser.mly" +# 1496 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 38564 "parsing/parser.ml" +# 38567 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -38568,13 +38571,13 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2389 "parsing/parser.mly" +# 2392 "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) ) -# 38578 "parsing/parser.ml" +# 38581 "parsing/parser.ml" in let _endpos__1_ = _endpos__9_ in @@ -38582,15 +38585,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38588 "parsing/parser.ml" +# 38591 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38594 "parsing/parser.ml" +# 38597 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38675,23 +38678,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 38681 "parsing/parser.ml" +# 38684 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 38687 "parsing/parser.ml" +# 38690 "parsing/parser.ml" in let _loc__8_ = (_startpos__8_, _endpos__8_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2396 "parsing/parser.mly" +# 2399 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__8_ ) -# 38695 "parsing/parser.ml" +# 38698 "parsing/parser.ml" in let _endpos__1_ = _endpos__8_ in @@ -38699,15 +38702,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 846 "parsing/parser.mly" +# 849 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 38705 "parsing/parser.ml" +# 38708 "parsing/parser.ml" in -# 2288 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( _1 ) -# 38711 "parsing/parser.ml" +# 38714 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38736,30 +38739,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38742 "parsing/parser.ml" +# 38745 "parsing/parser.ml" in -# 2666 "parsing/parser.mly" +# 2669 "parsing/parser.mly" ( Ppat_var (_1) ) -# 38748 "parsing/parser.ml" +# 38751 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38757 "parsing/parser.ml" +# 38760 "parsing/parser.ml" in -# 2667 "parsing/parser.mly" +# 2670 "parsing/parser.mly" ( _1 ) -# 38763 "parsing/parser.ml" +# 38766 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38782,9 +38785,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2668 "parsing/parser.mly" +# 2671 "parsing/parser.mly" ( _1 ) -# 38788 "parsing/parser.ml" +# 38791 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38824,9 +38827,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2673 "parsing/parser.mly" +# 2676 "parsing/parser.mly" ( reloc_pat ~loc:_sloc _2 ) -# 38830 "parsing/parser.ml" +# 38833 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38849,9 +38852,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2675 "parsing/parser.mly" +# 2678 "parsing/parser.mly" ( _1 ) -# 38855 "parsing/parser.ml" +# 38858 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38914,9 +38917,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38920 "parsing/parser.ml" +# 38923 "parsing/parser.ml" in let _3 = @@ -38924,24 +38927,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 38930 "parsing/parser.ml" +# 38933 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 38936 "parsing/parser.ml" +# 38939 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2677 "parsing/parser.mly" +# 2680 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 ) -# 38945 "parsing/parser.ml" +# 38948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39018,11 +39021,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 39026 "parsing/parser.ml" +# 39029 "parsing/parser.ml" in let _4 = @@ -39031,9 +39034,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39037 "parsing/parser.ml" +# 39040 "parsing/parser.ml" in let _3 = @@ -39041,26 +39044,26 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 39047 "parsing/parser.ml" +# 39050 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 39053 "parsing/parser.ml" +# 39056 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2679 "parsing/parser.mly" +# 2682 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_constraint(mkpat ~loc:_sloc (Ppat_unpack _4), _6)) _3 ) -# 39064 "parsing/parser.ml" +# 39067 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39084,23 +39087,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2687 "parsing/parser.mly" +# 2690 "parsing/parser.mly" ( Ppat_any ) -# 39090 "parsing/parser.ml" +# 39093 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39098 "parsing/parser.ml" +# 39101 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39104 "parsing/parser.ml" +# 39107 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39124,23 +39127,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2689 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( Ppat_constant _1 ) -# 39130 "parsing/parser.ml" +# 39133 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39138 "parsing/parser.ml" +# 39141 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39144 "parsing/parser.ml" +# 39147 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39178,24 +39181,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2691 "parsing/parser.mly" +# 2694 "parsing/parser.mly" ( Ppat_interval (_1, _3) ) -# 39184 "parsing/parser.ml" +# 39187 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39193 "parsing/parser.ml" +# 39196 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39199 "parsing/parser.ml" +# 39202 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39224,30 +39227,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39230 "parsing/parser.ml" +# 39233 "parsing/parser.ml" in -# 2693 "parsing/parser.mly" +# 2696 "parsing/parser.mly" ( Ppat_construct(_1, None) ) -# 39236 "parsing/parser.ml" +# 39239 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39245 "parsing/parser.ml" +# 39248 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39251 "parsing/parser.ml" +# 39254 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39271,23 +39274,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2695 "parsing/parser.mly" +# 2698 "parsing/parser.mly" ( Ppat_variant(_1, None) ) -# 39277 "parsing/parser.ml" +# 39280 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39285 "parsing/parser.ml" +# 39288 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39291 "parsing/parser.ml" +# 39294 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39324,15 +39327,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39330 "parsing/parser.ml" +# 39333 "parsing/parser.ml" in -# 2697 "parsing/parser.mly" +# 2700 "parsing/parser.mly" ( Ppat_type (_2) ) -# 39336 "parsing/parser.ml" +# 39339 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -39340,15 +39343,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39346 "parsing/parser.ml" +# 39349 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39352 "parsing/parser.ml" +# 39355 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39391,15 +39394,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39397 "parsing/parser.ml" +# 39400 "parsing/parser.ml" in -# 2699 "parsing/parser.mly" +# 2702 "parsing/parser.mly" ( Ppat_open(_1, _3) ) -# 39403 "parsing/parser.ml" +# 39406 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -39407,15 +39410,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39413 "parsing/parser.ml" +# 39416 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39419 "parsing/parser.ml" +# 39422 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39463,133 +39466,38 @@ module Tables = struct 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 "[]") -# 39469 "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 ) -# 39478 "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 ) -# 39489 "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))) ) -# 39498 "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 ) -# 39508 "parsing/parser.ml" - - in - -# 2683 "parsing/parser.mly" - ( _1 ) -# 39514 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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 "()") -# 39564 "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 ) -# 39573 "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 ) -# 39584 "parsing/parser.ml" - - in - let _endpos = _endpos__3_ in - let _symbolstartpos = _startpos__1_ in - let _sloc = (_symbolstartpos, _endpos) in - # 2703 "parsing/parser.mly" + (Lident "[]") +# 39472 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 39481 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 39492 "parsing/parser.ml" + + in + let _endpos = _endpos__3_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 2704 "parsing/parser.mly" ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) ) -# 39593 "parsing/parser.ml" +# 39501 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -39597,15 +39505,110 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39603 "parsing/parser.ml" +# 39511 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39609 "parsing/parser.ml" +# 39517 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 2705 "parsing/parser.mly" + (Lident "()") +# 39567 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 39576 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 39587 "parsing/parser.ml" + + in + let _endpos = _endpos__3_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 2706 "parsing/parser.mly" + ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) ) +# 39596 "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 + +# 851 "parsing/parser.mly" + ( mkpat ~loc:_sloc _1 ) +# 39606 "parsing/parser.ml" + + in + +# 2686 "parsing/parser.mly" + ( _1 ) +# 39612 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39662,15 +39665,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 39668 "parsing/parser.ml" +# 39671 "parsing/parser.ml" in -# 2705 "parsing/parser.mly" +# 2708 "parsing/parser.mly" ( Ppat_open (_1, _4) ) -# 39674 "parsing/parser.ml" +# 39677 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -39678,15 +39681,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39684 "parsing/parser.ml" +# 39687 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39690 "parsing/parser.ml" +# 39693 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39741,9 +39744,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2707 "parsing/parser.mly" +# 2710 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 39747 "parsing/parser.ml" +# 39750 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -39751,15 +39754,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39757 "parsing/parser.ml" +# 39760 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39763 "parsing/parser.ml" +# 39766 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39806,9 +39809,9 @@ module Tables = struct let _1 = let _loc__4_ = (_startpos__4_, _endpos__4_) in -# 2709 "parsing/parser.mly" +# 2712 "parsing/parser.mly" ( expecting _loc__4_ "pattern" ) -# 39812 "parsing/parser.ml" +# 39815 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -39816,15 +39819,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39822 "parsing/parser.ml" +# 39825 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39828 "parsing/parser.ml" +# 39831 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39865,9 +39868,9 @@ module Tables = struct let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2711 "parsing/parser.mly" +# 2714 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 39871 "parsing/parser.ml" +# 39874 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -39875,15 +39878,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39881 "parsing/parser.ml" +# 39884 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39887 "parsing/parser.ml" +# 39890 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39935,24 +39938,24 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2713 "parsing/parser.mly" +# 2716 "parsing/parser.mly" ( Ppat_constraint(_2, _4) ) -# 39941 "parsing/parser.ml" +# 39944 "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" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39950 "parsing/parser.ml" +# 39953 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 39956 "parsing/parser.ml" +# 39959 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40007,9 +40010,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2715 "parsing/parser.mly" +# 2718 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 40013 "parsing/parser.ml" +# 40016 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -40017,15 +40020,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 40023 "parsing/parser.ml" +# 40026 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 40029 "parsing/parser.ml" +# 40032 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40072,9 +40075,9 @@ module Tables = struct let _1 = let _loc__4_ = (_startpos__4_, _endpos__4_) in -# 2717 "parsing/parser.mly" +# 2720 "parsing/parser.mly" ( expecting _loc__4_ "type" ) -# 40078 "parsing/parser.ml" +# 40081 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -40082,15 +40085,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 40088 "parsing/parser.ml" +# 40091 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 40094 "parsing/parser.ml" +# 40097 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40169,11 +40172,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3330 "parsing/parser.mly" +# 3333 "parsing/parser.mly" ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in let descr = Ptyp_package (lid, cstrs) in mktyp ~loc:_sloc ~attrs descr ) -# 40177 "parsing/parser.ml" +# 40180 "parsing/parser.ml" in let _3 = @@ -40181,23 +40184,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 40187 "parsing/parser.ml" +# 40190 "parsing/parser.ml" in -# 3753 "parsing/parser.mly" +# 3756 "parsing/parser.mly" ( _1, _2 ) -# 40193 "parsing/parser.ml" +# 40196 "parsing/parser.ml" in let _loc__7_ = (_startpos__7_, _endpos__7_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2720 "parsing/parser.mly" +# 2723 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__7_ ) -# 40201 "parsing/parser.ml" +# 40204 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -40205,15 +40208,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 40211 "parsing/parser.ml" +# 40214 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 40217 "parsing/parser.ml" +# 40220 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40237,23 +40240,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2722 "parsing/parser.mly" +# 2725 "parsing/parser.mly" ( Ppat_extension _1 ) -# 40243 "parsing/parser.ml" +# 40246 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 848 "parsing/parser.mly" +# 851 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 40251 "parsing/parser.ml" +# 40254 "parsing/parser.ml" in -# 2683 "parsing/parser.mly" +# 2686 "parsing/parser.mly" ( _1 ) -# 40257 "parsing/parser.ml" +# 40260 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40272,96 +40275,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 40278 "parsing/parser.ml" +# 40281 "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) = -# 3663 "parsing/parser.mly" - ( _1 ) -# 40286 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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) -# 40307 "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) = -# 3664 "parsing/parser.mly" - ( _1 ) -# 40315 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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" - ( "and" ) -# 40340 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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" - ( "as" ) -# 40365 "parsing/parser.ml" + ( _1 ) +# 40289 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40379,14 +40303,18 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__1_; MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in - let _1 : unit = Obj.magic _1 in + let _1 : ( +# 700 "parsing/parser.mly" + (string) +# 40310 "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) = # 3667 "parsing/parser.mly" - ( "assert" ) -# 40390 "parsing/parser.ml" + ( _1 ) +# 40318 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40410,8 +40338,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3668 "parsing/parser.mly" - ( "begin" ) -# 40415 "parsing/parser.ml" + ( "and" ) +# 40343 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40435,8 +40363,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3669 "parsing/parser.mly" - ( "class" ) -# 40440 "parsing/parser.ml" + ( "as" ) +# 40368 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40460,8 +40388,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3670 "parsing/parser.mly" - ( "constraint" ) -# 40465 "parsing/parser.ml" + ( "assert" ) +# 40393 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40485,8 +40413,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3671 "parsing/parser.mly" - ( "do" ) -# 40490 "parsing/parser.ml" + ( "begin" ) +# 40418 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40510,8 +40438,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3672 "parsing/parser.mly" - ( "done" ) -# 40515 "parsing/parser.ml" + ( "class" ) +# 40443 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40535,8 +40463,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3673 "parsing/parser.mly" - ( "downto" ) -# 40540 "parsing/parser.ml" + ( "constraint" ) +# 40468 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40560,8 +40488,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3674 "parsing/parser.mly" - ( "else" ) -# 40565 "parsing/parser.ml" + ( "do" ) +# 40493 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40585,8 +40513,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3675 "parsing/parser.mly" - ( "end" ) -# 40590 "parsing/parser.ml" + ( "done" ) +# 40518 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40610,8 +40538,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3676 "parsing/parser.mly" - ( "exception" ) -# 40615 "parsing/parser.ml" + ( "downto" ) +# 40543 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40635,8 +40563,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3677 "parsing/parser.mly" - ( "external" ) -# 40640 "parsing/parser.ml" + ( "else" ) +# 40568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40660,8 +40588,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3678 "parsing/parser.mly" - ( "false" ) -# 40665 "parsing/parser.ml" + ( "end" ) +# 40593 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40685,8 +40613,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3679 "parsing/parser.mly" - ( "for" ) -# 40690 "parsing/parser.ml" + ( "exception" ) +# 40618 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40710,8 +40638,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3680 "parsing/parser.mly" - ( "fun" ) -# 40715 "parsing/parser.ml" + ( "external" ) +# 40643 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40735,8 +40663,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3681 "parsing/parser.mly" - ( "function" ) -# 40740 "parsing/parser.ml" + ( "false" ) +# 40668 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40760,8 +40688,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3682 "parsing/parser.mly" - ( "functor" ) -# 40765 "parsing/parser.ml" + ( "for" ) +# 40693 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40785,8 +40713,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3683 "parsing/parser.mly" - ( "if" ) -# 40790 "parsing/parser.ml" + ( "fun" ) +# 40718 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40810,8 +40738,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3684 "parsing/parser.mly" - ( "in" ) -# 40815 "parsing/parser.ml" + ( "function" ) +# 40743 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40835,8 +40763,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3685 "parsing/parser.mly" - ( "include" ) -# 40840 "parsing/parser.ml" + ( "functor" ) +# 40768 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40860,8 +40788,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3686 "parsing/parser.mly" - ( "inherit" ) -# 40865 "parsing/parser.ml" + ( "if" ) +# 40793 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40885,8 +40813,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3687 "parsing/parser.mly" - ( "initializer" ) -# 40890 "parsing/parser.ml" + ( "in" ) +# 40818 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40910,8 +40838,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3688 "parsing/parser.mly" - ( "lazy" ) -# 40915 "parsing/parser.ml" + ( "include" ) +# 40843 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40935,8 +40863,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3689 "parsing/parser.mly" - ( "let" ) -# 40940 "parsing/parser.ml" + ( "inherit" ) +# 40868 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40960,8 +40888,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3690 "parsing/parser.mly" - ( "match" ) -# 40965 "parsing/parser.ml" + ( "initializer" ) +# 40893 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40985,8 +40913,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3691 "parsing/parser.mly" - ( "method" ) -# 40990 "parsing/parser.ml" + ( "lazy" ) +# 40918 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41010,8 +40938,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3692 "parsing/parser.mly" - ( "module" ) -# 41015 "parsing/parser.ml" + ( "let" ) +# 40943 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41035,8 +40963,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3693 "parsing/parser.mly" - ( "mutable" ) -# 41040 "parsing/parser.ml" + ( "match" ) +# 40968 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41060,8 +40988,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3694 "parsing/parser.mly" - ( "new" ) -# 41065 "parsing/parser.ml" + ( "method" ) +# 40993 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41085,8 +41013,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3695 "parsing/parser.mly" - ( "nonrec" ) -# 41090 "parsing/parser.ml" + ( "module" ) +# 41018 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41110,8 +41038,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3696 "parsing/parser.mly" - ( "object" ) -# 41115 "parsing/parser.ml" + ( "mutable" ) +# 41043 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41135,8 +41063,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3697 "parsing/parser.mly" - ( "of" ) -# 41140 "parsing/parser.ml" + ( "new" ) +# 41068 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41160,8 +41088,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3698 "parsing/parser.mly" - ( "open" ) -# 41165 "parsing/parser.ml" + ( "nonrec" ) +# 41093 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41185,8 +41113,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3699 "parsing/parser.mly" - ( "or" ) -# 41190 "parsing/parser.ml" + ( "object" ) +# 41118 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41210,8 +41138,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3700 "parsing/parser.mly" - ( "private" ) -# 41215 "parsing/parser.ml" + ( "of" ) +# 41143 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41235,8 +41163,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3701 "parsing/parser.mly" - ( "rec" ) -# 41240 "parsing/parser.ml" + ( "open" ) +# 41168 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41260,8 +41188,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3702 "parsing/parser.mly" - ( "sig" ) -# 41265 "parsing/parser.ml" + ( "or" ) +# 41193 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41285,8 +41213,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3703 "parsing/parser.mly" - ( "struct" ) -# 41290 "parsing/parser.ml" + ( "private" ) +# 41218 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41310,8 +41238,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3704 "parsing/parser.mly" - ( "then" ) -# 41315 "parsing/parser.ml" + ( "rec" ) +# 41243 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41335,8 +41263,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3705 "parsing/parser.mly" - ( "to" ) -# 41340 "parsing/parser.ml" + ( "sig" ) +# 41268 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41360,8 +41288,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3706 "parsing/parser.mly" - ( "true" ) -# 41365 "parsing/parser.ml" + ( "struct" ) +# 41293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41385,8 +41313,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3707 "parsing/parser.mly" - ( "try" ) -# 41390 "parsing/parser.ml" + ( "then" ) +# 41318 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41410,8 +41338,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3708 "parsing/parser.mly" - ( "type" ) -# 41415 "parsing/parser.ml" + ( "to" ) +# 41343 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41435,8 +41363,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3709 "parsing/parser.mly" - ( "val" ) -# 41440 "parsing/parser.ml" + ( "true" ) +# 41368 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41460,8 +41388,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3710 "parsing/parser.mly" - ( "virtual" ) -# 41465 "parsing/parser.ml" + ( "try" ) +# 41393 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41485,8 +41413,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3711 "parsing/parser.mly" - ( "when" ) -# 41490 "parsing/parser.ml" + ( "type" ) +# 41418 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41510,8 +41438,8 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3712 "parsing/parser.mly" - ( "while" ) -# 41515 "parsing/parser.ml" + ( "val" ) +# 41443 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41535,8 +41463,83 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string) = # 3713 "parsing/parser.mly" + ( "virtual" ) +# 41468 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = +# 3714 "parsing/parser.mly" + ( "when" ) +# 41493 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = +# 3715 "parsing/parser.mly" + ( "while" ) +# 41518 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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) = +# 3716 "parsing/parser.mly" ( "with" ) -# 41540 "parsing/parser.ml" +# 41543 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41559,9 +41562,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.type_exception * string Asttypes.loc option) = -# 2998 "parsing/parser.mly" +# 3001 "parsing/parser.mly" ( _1 ) -# 41565 "parsing/parser.ml" +# 41568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41635,18 +41638,18 @@ module Tables = struct let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs = let _1 = _1_inlined5 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 41641 "parsing/parser.ml" +# 41644 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined5_ in let attrs2 = let _1 = _1_inlined4 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 41650 "parsing/parser.ml" +# 41653 "parsing/parser.ml" in let lid = @@ -41655,9 +41658,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41661 "parsing/parser.ml" +# 41664 "parsing/parser.ml" in let id = @@ -41666,30 +41669,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41672 "parsing/parser.ml" +# 41675 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 41680 "parsing/parser.ml" +# 41683 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3007 "parsing/parser.mly" +# 3010 "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 ) -# 41693 "parsing/parser.ml" +# 41696 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41719,9 +41722,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2511 "parsing/parser.mly" +# 2514 "parsing/parser.mly" ( _2 ) -# 41725 "parsing/parser.ml" +# 41728 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41754,9 +41757,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2513 "parsing/parser.mly" +# 2516 "parsing/parser.mly" ( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) ) -# 41760 "parsing/parser.ml" +# 41763 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41807,17 +41810,17 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.expression) = let _3 = -# 2414 "parsing/parser.mly" +# 2417 "parsing/parser.mly" ( xs ) -# 41813 "parsing/parser.ml" +# 41816 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2515 "parsing/parser.mly" +# 2518 "parsing/parser.mly" ( mk_newtypes ~loc:_sloc _3 _5 ) -# 41821 "parsing/parser.ml" +# 41824 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41844,39 +41847,39 @@ module Tables = struct let ys = # 260 "" ( List.flatten xss ) -# 41848 "parsing/parser.ml" +# 41851 "parsing/parser.ml" in let xs = let items = -# 883 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( [] ) -# 41854 "parsing/parser.ml" +# 41857 "parsing/parser.ml" in -# 1297 "parsing/parser.mly" +# 1300 "parsing/parser.mly" ( items ) -# 41859 "parsing/parser.ml" +# 41862 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 41865 "parsing/parser.ml" +# 41868 "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" +# 808 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 41874 "parsing/parser.ml" +# 41877 "parsing/parser.ml" in -# 1290 "parsing/parser.mly" +# 1293 "parsing/parser.mly" ( _1 ) -# 41880 "parsing/parser.ml" +# 41883 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41917,7 +41920,7 @@ module Tables = struct let ys = # 260 "" ( List.flatten xss ) -# 41921 "parsing/parser.ml" +# 41924 "parsing/parser.ml" in let xs = let items = @@ -41925,65 +41928,65 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 41931 "parsing/parser.ml" +# 41934 "parsing/parser.ml" in -# 1304 "parsing/parser.mly" +# 1307 "parsing/parser.mly" ( mkstrexp e attrs ) -# 41936 "parsing/parser.ml" +# 41939 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 817 "parsing/parser.mly" +# 820 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 41944 "parsing/parser.ml" +# 41947 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 836 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 41954 "parsing/parser.ml" +# 41957 "parsing/parser.ml" in -# 885 "parsing/parser.mly" +# 888 "parsing/parser.mly" ( x ) -# 41960 "parsing/parser.ml" +# 41963 "parsing/parser.ml" in -# 1297 "parsing/parser.mly" +# 1300 "parsing/parser.mly" ( items ) -# 41966 "parsing/parser.ml" +# 41969 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 41972 "parsing/parser.ml" +# 41975 "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" +# 808 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 41981 "parsing/parser.ml" +# 41984 "parsing/parser.ml" in -# 1290 "parsing/parser.mly" +# 1293 "parsing/parser.mly" ( _1 ) -# 41987 "parsing/parser.ml" +# 41990 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42009,9 +42012,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1319 "parsing/parser.mly" +# 1322 "parsing/parser.mly" ( val_of_let_bindings ~loc:_sloc _1 ) -# 42015 "parsing/parser.ml" +# 42018 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42045,9 +42048,9 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 42051 "parsing/parser.ml" +# 42054 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -42055,10 +42058,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1322 "parsing/parser.mly" +# 1325 "parsing/parser.mly" ( let docs = symbol_docs _sloc in Pstr_extension (_1, add_docs_attrs docs _2) ) -# 42062 "parsing/parser.ml" +# 42065 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -42066,15 +42069,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 852 "parsing/parser.mly" +# 855 "parsing/parser.mly" ( mkstr ~loc:_sloc _1 ) -# 42072 "parsing/parser.ml" +# 42075 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42078 "parsing/parser.ml" +# 42081 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42098,23 +42101,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1325 "parsing/parser.mly" +# 1328 "parsing/parser.mly" ( Pstr_attribute _1 ) -# 42104 "parsing/parser.ml" +# 42107 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 852 "parsing/parser.mly" +# 855 "parsing/parser.mly" ( mkstr ~loc:_sloc _1 ) -# 42112 "parsing/parser.ml" +# 42115 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42118 "parsing/parser.ml" +# 42121 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42138,23 +42141,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1329 "parsing/parser.mly" +# 1332 "parsing/parser.mly" ( pstr_primitive _1 ) -# 42144 "parsing/parser.ml" +# 42147 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42152 "parsing/parser.ml" +# 42155 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42158 "parsing/parser.ml" +# 42161 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42178,23 +42181,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1331 "parsing/parser.mly" +# 1334 "parsing/parser.mly" ( pstr_primitive _1 ) -# 42184 "parsing/parser.ml" +# 42187 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42192 "parsing/parser.ml" +# 42195 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42198 "parsing/parser.ml" +# 42201 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42229,26 +42232,26 @@ module Tables = struct let _1 = let _1 = let _1 = -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 42235 "parsing/parser.ml" +# 42238 "parsing/parser.ml" in -# 2842 "parsing/parser.mly" +# 2845 "parsing/parser.mly" ( _1 ) -# 42240 "parsing/parser.ml" +# 42243 "parsing/parser.ml" in -# 2825 "parsing/parser.mly" +# 2828 "parsing/parser.mly" ( _1 ) -# 42246 "parsing/parser.ml" +# 42249 "parsing/parser.ml" in -# 1333 "parsing/parser.mly" +# 1336 "parsing/parser.mly" ( pstr_type _1 ) -# 42252 "parsing/parser.ml" +# 42255 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -42256,15 +42259,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42262 "parsing/parser.ml" +# 42265 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42268 "parsing/parser.ml" +# 42271 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42349,16 +42352,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 42355 "parsing/parser.ml" +# 42358 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let cs = -# 1036 "parsing/parser.mly" +# 1039 "parsing/parser.mly" ( List.rev xs ) -# 42362 "parsing/parser.ml" +# 42365 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -42366,46 +42369,46 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42372 "parsing/parser.ml" +# 42375 "parsing/parser.ml" in let _4 = -# 3585 "parsing/parser.mly" +# 3588 "parsing/parser.mly" ( Recursive ) -# 42378 "parsing/parser.ml" +# 42381 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 42385 "parsing/parser.ml" +# 42388 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3090 "parsing/parser.mly" +# 3093 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 42397 "parsing/parser.ml" +# 42400 "parsing/parser.ml" in -# 3073 "parsing/parser.mly" +# 3076 "parsing/parser.mly" ( _1 ) -# 42403 "parsing/parser.ml" +# 42406 "parsing/parser.ml" in -# 1335 "parsing/parser.mly" +# 1338 "parsing/parser.mly" ( pstr_typext _1 ) -# 42409 "parsing/parser.ml" +# 42412 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -42413,15 +42416,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42419 "parsing/parser.ml" +# 42422 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42425 "parsing/parser.ml" +# 42428 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42513,16 +42516,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 42519 "parsing/parser.ml" +# 42522 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in let cs = -# 1036 "parsing/parser.mly" +# 1039 "parsing/parser.mly" ( List.rev xs ) -# 42526 "parsing/parser.ml" +# 42529 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -42530,9 +42533,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42536 "parsing/parser.ml" +# 42539 "parsing/parser.ml" in let _4 = @@ -42541,41 +42544,41 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3586 "parsing/parser.mly" +# 3589 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 42547 "parsing/parser.ml" +# 42550 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 42555 "parsing/parser.ml" +# 42558 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3090 "parsing/parser.mly" +# 3093 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 42567 "parsing/parser.ml" +# 42570 "parsing/parser.ml" in -# 3073 "parsing/parser.mly" +# 3076 "parsing/parser.mly" ( _1 ) -# 42573 "parsing/parser.ml" +# 42576 "parsing/parser.ml" in -# 1335 "parsing/parser.mly" +# 1338 "parsing/parser.mly" ( pstr_typext _1 ) -# 42579 "parsing/parser.ml" +# 42582 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -42583,15 +42586,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42589 "parsing/parser.ml" +# 42592 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42595 "parsing/parser.ml" +# 42598 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42615,23 +42618,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1337 "parsing/parser.mly" +# 1340 "parsing/parser.mly" ( pstr_exception _1 ) -# 42621 "parsing/parser.ml" +# 42624 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42629 "parsing/parser.ml" +# 42632 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42635 "parsing/parser.ml" +# 42638 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42694,9 +42697,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 42700 "parsing/parser.ml" +# 42703 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -42706,36 +42709,36 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42712 "parsing/parser.ml" +# 42715 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 42720 "parsing/parser.ml" +# 42723 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1363 "parsing/parser.mly" +# 1366 "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 ) -# 42733 "parsing/parser.ml" +# 42736 "parsing/parser.ml" in -# 1339 "parsing/parser.mly" +# 1342 "parsing/parser.mly" ( _1 ) -# 42739 "parsing/parser.ml" +# 42742 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -42743,15 +42746,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42749 "parsing/parser.ml" +# 42752 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42755 "parsing/parser.ml" +# 42758 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42830,9 +42833,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 42836 "parsing/parser.ml" +# 42839 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -42842,24 +42845,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42848 "parsing/parser.ml" +# 42851 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 42856 "parsing/parser.ml" +# 42859 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1397 "parsing/parser.mly" +# 1400 "parsing/parser.mly" ( let loc = make_loc _sloc in let attrs = attrs1 @ attrs2 in @@ -42867,25 +42870,25 @@ module Tables = struct ext, Mb.mk name body ~attrs ~loc ~docs ) -# 42871 "parsing/parser.ml" +# 42874 "parsing/parser.ml" in -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 42877 "parsing/parser.ml" +# 42880 "parsing/parser.ml" in -# 1385 "parsing/parser.mly" +# 1388 "parsing/parser.mly" ( _1 ) -# 42883 "parsing/parser.ml" +# 42886 "parsing/parser.ml" in -# 1341 "parsing/parser.mly" +# 1344 "parsing/parser.mly" ( pstr_recmodule _1 ) -# 42889 "parsing/parser.ml" +# 42892 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -42893,15 +42896,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42899 "parsing/parser.ml" +# 42902 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42905 "parsing/parser.ml" +# 42908 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42925,23 +42928,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1343 "parsing/parser.mly" +# 1346 "parsing/parser.mly" ( let (body, ext) = _1 in (Pstr_modtype body, ext) ) -# 42931 "parsing/parser.ml" +# 42934 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42939 "parsing/parser.ml" +# 42942 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42945 "parsing/parser.ml" +# 42948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42965,23 +42968,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1345 "parsing/parser.mly" +# 1348 "parsing/parser.mly" ( let (body, ext) = _1 in (Pstr_open body, ext) ) -# 42971 "parsing/parser.ml" +# 42974 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42979 "parsing/parser.ml" +# 42982 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 42985 "parsing/parser.ml" +# 42988 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43051,9 +43054,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.class_expr) = Obj.magic body in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 43057 "parsing/parser.ml" +# 43060 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -43071,9 +43074,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 43077 "parsing/parser.ml" +# 43080 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -43083,24 +43086,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43089 "parsing/parser.ml" +# 43092 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 43097 "parsing/parser.ml" +# 43100 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1715 "parsing/parser.mly" +# 1718 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -43108,25 +43111,25 @@ module Tables = struct ext, Ci.mk id body ~virt ~params ~attrs ~loc ~docs ) -# 43112 "parsing/parser.ml" +# 43115 "parsing/parser.ml" in -# 1044 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 43118 "parsing/parser.ml" +# 43121 "parsing/parser.ml" in -# 1704 "parsing/parser.mly" +# 1707 "parsing/parser.mly" ( _1 ) -# 43124 "parsing/parser.ml" +# 43127 "parsing/parser.ml" in -# 1347 "parsing/parser.mly" +# 1350 "parsing/parser.mly" ( let (ext, l) = _1 in (Pstr_class l, ext) ) -# 43130 "parsing/parser.ml" +# 43133 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -43134,15 +43137,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 43140 "parsing/parser.ml" +# 43143 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 43146 "parsing/parser.ml" +# 43149 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43166,23 +43169,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1349 "parsing/parser.mly" +# 1352 "parsing/parser.mly" ( let (ext, l) = _1 in (Pstr_class_type l, ext) ) -# 43172 "parsing/parser.ml" +# 43175 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 43180 "parsing/parser.ml" +# 43183 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 43186 "parsing/parser.ml" +# 43189 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43238,38 +43241,38 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 43244 "parsing/parser.ml" +# 43247 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 43253 "parsing/parser.ml" +# 43256 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1434 "parsing/parser.mly" +# 1437 "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 ) -# 43267 "parsing/parser.ml" +# 43270 "parsing/parser.ml" in -# 1351 "parsing/parser.mly" +# 1354 "parsing/parser.mly" ( pstr_include _1 ) -# 43273 "parsing/parser.ml" +# 43276 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined2_ in @@ -43277,15 +43280,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 869 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 43283 "parsing/parser.ml" +# 43286 "parsing/parser.ml" in -# 1353 "parsing/parser.mly" +# 1356 "parsing/parser.mly" ( _1 ) -# 43289 "parsing/parser.ml" +# 43292 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43308,9 +43311,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3648 "parsing/parser.mly" +# 3651 "parsing/parser.mly" ( "-" ) -# 43314 "parsing/parser.ml" +# 43317 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43333,9 +43336,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3649 "parsing/parser.mly" +# 3652 "parsing/parser.mly" ( "-." ) -# 43339 "parsing/parser.ml" +# 43342 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43388,9 +43391,9 @@ module Tables = struct let _v : (Parsetree.row_field) = let _5 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 43394 "parsing/parser.ml" +# 43397 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined1_ in @@ -43399,18 +43402,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 43403 "parsing/parser.ml" +# 43406 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 43408 "parsing/parser.ml" +# 43411 "parsing/parser.ml" in -# 3360 "parsing/parser.mly" +# 3363 "parsing/parser.mly" ( _1 ) -# 43414 "parsing/parser.ml" +# 43417 "parsing/parser.ml" in let _1 = @@ -43418,20 +43421,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43424 "parsing/parser.ml" +# 43427 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3346 "parsing/parser.mly" +# 3349 "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 ) -# 43435 "parsing/parser.ml" +# 43438 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43463,9 +43466,9 @@ module Tables = struct let _v : (Parsetree.row_field) = let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 43469 "parsing/parser.ml" +# 43472 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -43474,20 +43477,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43480 "parsing/parser.ml" +# 43483 "parsing/parser.ml" in let _endpos = _endpos__2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3350 "parsing/parser.mly" +# 3353 "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 [] ) -# 43491 "parsing/parser.ml" +# 43494 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43519,7 +43522,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase) = let arg = # 124 "" ( None ) -# 43523 "parsing/parser.ml" +# 43526 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined1_ in let dir = @@ -43528,18 +43531,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43534 "parsing/parser.ml" +# 43537 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3548 "parsing/parser.mly" +# 3551 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43543 "parsing/parser.ml" +# 43546 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43570,9 +43573,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined2 : ( -# 685 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string * Location.t * string option) -# 43576 "parsing/parser.ml" +# 43579 "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 @@ -43583,258 +43586,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3552 "parsing/parser.mly" - ( let (s, _, _) = _1 in Pdir_string s ) -# 43589 "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 ) -# 43597 "parsing/parser.ml" - - in - -# 126 "" - ( Some x ) -# 43603 "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 ) -# 43615 "parsing/parser.ml" - - in - let _endpos = _endpos_arg_ in - let _symbolstartpos = _startpos__1_ in - let _sloc = (_symbolstartpos, _endpos) in - -# 3548 "parsing/parser.mly" - ( mk_directive ~loc:_sloc dir arg ) -# 43624 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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) -# 43657 "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 = -# 3553 "parsing/parser.mly" - ( let (n, m) = _1 in Pdir_int (n ,m) ) -# 43670 "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 ) -# 43678 "parsing/parser.ml" - - in - -# 126 "" - ( Some x ) -# 43684 "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 ) -# 43696 "parsing/parser.ml" - - in - let _endpos = _endpos_arg_ in - let _symbolstartpos = _startpos__1_ in - let _sloc = (_symbolstartpos, _endpos) in - -# 3548 "parsing/parser.mly" - ( mk_directive ~loc:_sloc dir arg ) -# 43705 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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 = -# 3554 "parsing/parser.mly" - ( Pdir_ident _1 ) -# 43747 "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 ) -# 43755 "parsing/parser.ml" - - in - -# 126 "" - ( Some x ) -# 43761 "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 ) -# 43773 "parsing/parser.ml" - - in - let _endpos = _endpos_arg_ in - let _symbolstartpos = _startpos__1_ in - let _sloc = (_symbolstartpos, _endpos) in - -# 3548 "parsing/parser.mly" - ( mk_directive ~loc:_sloc dir arg ) -# 43782 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - 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 = # 3555 "parsing/parser.mly" - ( Pdir_ident _1 ) -# 43824 "parsing/parser.ml" + ( let (s, _, _) = _1 in Pdir_string s ) +# 43592 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 874 "parsing/parser.mly" +# 877 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 43832 "parsing/parser.ml" +# 43600 "parsing/parser.ml" in # 126 "" ( Some x ) -# 43838 "parsing/parser.ml" +# 43606 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43844,18 +43612,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43850 "parsing/parser.ml" +# 43618 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3548 "parsing/parser.mly" +# 3551 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43859 "parsing/parser.ml" +# 43627 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43885,7 +43653,11 @@ module Tables = struct }; }; } = _menhir_stack in - let _1_inlined2 : unit = Obj.magic _1_inlined2 in + let _1_inlined2 : ( +# 636 "parsing/parser.mly" + (string * char option) +# 43660 "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 @@ -43896,22 +43668,22 @@ module Tables = struct let x = let _1 = # 3556 "parsing/parser.mly" - ( Pdir_bool false ) -# 43901 "parsing/parser.ml" + ( let (n, m) = _1 in Pdir_int (n ,m) ) +# 43673 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 874 "parsing/parser.mly" +# 877 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 43909 "parsing/parser.ml" +# 43681 "parsing/parser.ml" in # 126 "" ( Some x ) -# 43915 "parsing/parser.ml" +# 43687 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43921,18 +43693,172 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43927 "parsing/parser.ml" +# 43699 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3548 "parsing/parser.mly" +# 3551 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43936 "parsing/parser.ml" +# 43708 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 3557 "parsing/parser.mly" + ( Pdir_ident _1 ) +# 43750 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 877 "parsing/parser.mly" + ( mk_directive_arg ~loc:_sloc _1 ) +# 43758 "parsing/parser.ml" + + in + +# 126 "" + ( Some x ) +# 43764 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 43776 "parsing/parser.ml" + + in + let _endpos = _endpos_arg_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 3551 "parsing/parser.mly" + ( mk_directive ~loc:_sloc dir arg ) +# 43785 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 3558 "parsing/parser.mly" + ( Pdir_ident _1 ) +# 43827 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 877 "parsing/parser.mly" + ( mk_directive_arg ~loc:_sloc _1 ) +# 43835 "parsing/parser.ml" + + in + +# 126 "" + ( Some x ) +# 43841 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 43853 "parsing/parser.ml" + + in + let _endpos = _endpos_arg_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 3551 "parsing/parser.mly" + ( mk_directive ~loc:_sloc dir arg ) +# 43862 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43972,23 +43898,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3557 "parsing/parser.mly" - ( Pdir_bool true ) -# 43978 "parsing/parser.ml" +# 3559 "parsing/parser.mly" + ( Pdir_bool false ) +# 43904 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 874 "parsing/parser.mly" +# 877 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 43986 "parsing/parser.ml" +# 43912 "parsing/parser.ml" in # 126 "" ( Some x ) -# 43992 "parsing/parser.ml" +# 43918 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43998,18 +43924,95 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44004 "parsing/parser.ml" +# 43930 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3548 "parsing/parser.mly" +# 3551 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 44013 "parsing/parser.ml" +# 43939 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + 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 = +# 3560 "parsing/parser.mly" + ( Pdir_bool true ) +# 43981 "parsing/parser.ml" + in + let _endpos = _endpos__1_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 877 "parsing/parser.mly" + ( mk_directive_arg ~loc:_sloc _1 ) +# 43989 "parsing/parser.ml" + + in + +# 126 "" + ( Some x ) +# 43995 "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 + +# 816 "parsing/parser.mly" + ( mkrhs _1 _sloc ) +# 44007 "parsing/parser.ml" + + in + let _endpos = _endpos_arg_ in + let _symbolstartpos = _startpos__1_ in + let _sloc = (_symbolstartpos, _endpos) in + +# 3551 "parsing/parser.mly" + ( mk_directive ~loc:_sloc dir arg ) +# 44016 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44046,44 +44049,44 @@ module Tables = struct let _startpos = _startpos_e_ in let _endpos = _endpos__2_ in let _v : ( -# 781 "parsing/parser.mly" +# 784 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 44052 "parsing/parser.ml" +# 44055 "parsing/parser.ml" ) = let _1 = let _1 = let _1 = let attrs = -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 44059 "parsing/parser.ml" +# 44062 "parsing/parser.ml" in -# 1304 "parsing/parser.mly" +# 1307 "parsing/parser.mly" ( mkstrexp e attrs ) -# 44064 "parsing/parser.ml" +# 44067 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 817 "parsing/parser.mly" +# 820 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 44072 "parsing/parser.ml" +# 44075 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 805 "parsing/parser.mly" +# 808 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 44081 "parsing/parser.ml" +# 44084 "parsing/parser.ml" in -# 1082 "parsing/parser.mly" +# 1085 "parsing/parser.mly" ( Ptop_def _1 ) -# 44087 "parsing/parser.ml" +# 44090 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44113,28 +44116,28 @@ module Tables = struct let _startpos = _startpos_xss_ in let _endpos = _endpos__2_ in let _v : ( -# 781 "parsing/parser.mly" +# 784 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 44119 "parsing/parser.ml" +# 44122 "parsing/parser.ml" ) = let _1 = let _1 = # 260 "" ( List.flatten xss ) -# 44124 "parsing/parser.ml" +# 44127 "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" +# 808 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 44132 "parsing/parser.ml" +# 44135 "parsing/parser.ml" in -# 1086 "parsing/parser.mly" +# 1089 "parsing/parser.mly" ( Ptop_def _1 ) -# 44138 "parsing/parser.ml" +# 44141 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44164,13 +44167,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 781 "parsing/parser.mly" +# 784 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 44170 "parsing/parser.ml" +# 44173 "parsing/parser.ml" ) = -# 1090 "parsing/parser.mly" +# 1093 "parsing/parser.mly" ( _1 ) -# 44174 "parsing/parser.ml" +# 44177 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44193,13 +44196,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : ( -# 781 "parsing/parser.mly" +# 784 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 44199 "parsing/parser.ml" +# 44202 "parsing/parser.ml" ) = -# 1093 "parsing/parser.mly" +# 1096 "parsing/parser.mly" ( raise End_of_file ) -# 44203 "parsing/parser.ml" +# 44206 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44222,9 +44225,9 @@ module Tables = struct let _startpos = _startpos_ty_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.core_type) = -# 3252 "parsing/parser.mly" +# 3255 "parsing/parser.mly" ( ty ) -# 44228 "parsing/parser.ml" +# 44231 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44252,18 +44255,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 44256 "parsing/parser.ml" +# 44259 "parsing/parser.ml" in -# 975 "parsing/parser.mly" +# 978 "parsing/parser.mly" ( xs ) -# 44261 "parsing/parser.ml" +# 44264 "parsing/parser.ml" in -# 3255 "parsing/parser.mly" +# 3258 "parsing/parser.mly" ( Ptyp_tuple tys ) -# 44267 "parsing/parser.ml" +# 44270 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in @@ -44271,15 +44274,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 44277 "parsing/parser.ml" +# 44280 "parsing/parser.ml" in -# 3257 "parsing/parser.mly" +# 3260 "parsing/parser.mly" ( _1 ) -# 44283 "parsing/parser.ml" +# 44286 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44309,9 +44312,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2589 "parsing/parser.mly" +# 2592 "parsing/parser.mly" ( (Some _2, None) ) -# 44315 "parsing/parser.ml" +# 44318 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44355,9 +44358,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2590 "parsing/parser.mly" +# 2593 "parsing/parser.mly" ( (Some _2, Some _4) ) -# 44361 "parsing/parser.ml" +# 44364 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44387,9 +44390,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2591 "parsing/parser.mly" +# 2594 "parsing/parser.mly" ( (None, Some _2) ) -# 44393 "parsing/parser.ml" +# 44396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44419,9 +44422,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2592 "parsing/parser.mly" +# 2595 "parsing/parser.mly" ( syntax_error() ) -# 44425 "parsing/parser.ml" +# 44428 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44451,9 +44454,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2593 "parsing/parser.mly" +# 2596 "parsing/parser.mly" ( syntax_error() ) -# 44457 "parsing/parser.ml" +# 44460 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44469,9 +44472,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = -# 2916 "parsing/parser.mly" +# 2919 "parsing/parser.mly" ( (Ptype_abstract, Public, None) ) -# 44475 "parsing/parser.ml" +# 44478 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44501,9 +44504,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = -# 2918 "parsing/parser.mly" +# 2921 "parsing/parser.mly" ( _2 ) -# 44507 "parsing/parser.ml" +# 44510 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44526,9 +44529,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3511 "parsing/parser.mly" +# 3514 "parsing/parser.mly" ( _1 ) -# 44532 "parsing/parser.ml" +# 44535 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44558,9 +44561,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) = -# 2933 "parsing/parser.mly" +# 2936 "parsing/parser.mly" ( _2, _1 ) -# 44564 "parsing/parser.ml" +# 44567 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44576,9 +44579,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = -# 2926 "parsing/parser.mly" +# 2929 "parsing/parser.mly" ( [] ) -# 44582 "parsing/parser.ml" +# 44585 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44601,9 +44604,9 @@ module Tables = struct let _startpos = _startpos_p_ in let _endpos = _endpos_p_ in let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = -# 2928 "parsing/parser.mly" +# 2931 "parsing/parser.mly" ( [p] ) -# 44607 "parsing/parser.ml" +# 44610 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44643,18 +44646,18 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 44647 "parsing/parser.ml" +# 44650 "parsing/parser.ml" in -# 947 "parsing/parser.mly" +# 950 "parsing/parser.mly" ( xs ) -# 44652 "parsing/parser.ml" +# 44655 "parsing/parser.ml" in -# 2930 "parsing/parser.mly" +# 2933 "parsing/parser.mly" ( ps ) -# 44658 "parsing/parser.ml" +# 44661 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44685,24 +44688,24 @@ module Tables = struct let _endpos = _endpos_tyvar_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 2938 "parsing/parser.mly" +# 2941 "parsing/parser.mly" ( Ptyp_var tyvar ) -# 44691 "parsing/parser.ml" +# 44694 "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" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 44700 "parsing/parser.ml" +# 44703 "parsing/parser.ml" in -# 2941 "parsing/parser.mly" +# 2944 "parsing/parser.mly" ( _1 ) -# 44706 "parsing/parser.ml" +# 44709 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44726,23 +44729,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 2940 "parsing/parser.mly" +# 2943 "parsing/parser.mly" ( Ptyp_any ) -# 44732 "parsing/parser.ml" +# 44735 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 850 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 44740 "parsing/parser.ml" +# 44743 "parsing/parser.ml" in -# 2941 "parsing/parser.mly" +# 2944 "parsing/parser.mly" ( _1 ) -# 44746 "parsing/parser.ml" +# 44749 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44758,84 +44761,84 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.variance * Asttypes.injectivity) = -# 2945 "parsing/parser.mly" - ( NoVariance, NoInjectivity ) -# 44764 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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 * Asttypes.injectivity) = -# 2946 "parsing/parser.mly" - ( Covariant, NoInjectivity ) -# 44789 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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 * Asttypes.injectivity) = -# 2947 "parsing/parser.mly" - ( Contravariant, NoInjectivity ) -# 44814 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.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 * Asttypes.injectivity) = # 2948 "parsing/parser.mly" + ( NoVariance, NoInjectivity ) +# 44767 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 * Asttypes.injectivity) = +# 2949 "parsing/parser.mly" + ( Covariant, NoInjectivity ) +# 44792 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 * Asttypes.injectivity) = +# 2950 "parsing/parser.mly" + ( Contravariant, NoInjectivity ) +# 44817 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.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 * Asttypes.injectivity) = +# 2951 "parsing/parser.mly" ( NoVariance, Injective ) -# 44839 "parsing/parser.ml" +# 44842 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44865,9 +44868,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.variance * Asttypes.injectivity) = -# 2949 "parsing/parser.mly" +# 2952 "parsing/parser.mly" ( Covariant, Injective ) -# 44871 "parsing/parser.ml" +# 44874 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44897,9 +44900,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.variance * Asttypes.injectivity) = -# 2949 "parsing/parser.mly" +# 2952 "parsing/parser.mly" ( Covariant, Injective ) -# 44903 "parsing/parser.ml" +# 44906 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44929,9 +44932,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.variance * Asttypes.injectivity) = -# 2950 "parsing/parser.mly" +# 2953 "parsing/parser.mly" ( Contravariant, Injective ) -# 44935 "parsing/parser.ml" +# 44938 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44961,9 +44964,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.variance * Asttypes.injectivity) = -# 2950 "parsing/parser.mly" +# 2953 "parsing/parser.mly" ( Contravariant, Injective ) -# 44967 "parsing/parser.ml" +# 44970 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44982,20 +44985,20 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 625 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string) -# 44988 "parsing/parser.ml" +# 44991 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2952 "parsing/parser.mly" +# 2955 "parsing/parser.mly" ( if _1 = "+!" then Covariant, Injective else if _1 = "-!" then Contravariant, Injective else expecting _loc__1_ "type_variance" ) -# 44999 "parsing/parser.ml" +# 45002 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45014,20 +45017,20 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 671 "parsing/parser.mly" +# 674 "parsing/parser.mly" (string) -# 45020 "parsing/parser.ml" +# 45023 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2956 "parsing/parser.mly" +# 2959 "parsing/parser.mly" ( if _1 = "!+" then Covariant, Injective else if _1 = "!-" then Contravariant, Injective else expecting _loc__1_ "type_variance" ) -# 45031 "parsing/parser.ml" +# 45034 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45057,47 +45060,47 @@ module Tables = struct let _startpos = _startpos_xss_ in let _endpos = _endpos__2_ in let _v : ( -# 783 "parsing/parser.mly" +# 786 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 45063 "parsing/parser.ml" +# 45066 "parsing/parser.ml" ) = let _1 = let _1 = let ys = # 260 "" ( List.flatten xss ) -# 45069 "parsing/parser.ml" +# 45072 "parsing/parser.ml" in let xs = let _1 = -# 883 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( [] ) -# 45075 "parsing/parser.ml" +# 45078 "parsing/parser.ml" in -# 1113 "parsing/parser.mly" +# 1116 "parsing/parser.mly" ( _1 ) -# 45080 "parsing/parser.ml" +# 45083 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 45086 "parsing/parser.ml" +# 45089 "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" +# 812 "parsing/parser.mly" ( extra_def _startpos _endpos _1 ) -# 45095 "parsing/parser.ml" +# 45098 "parsing/parser.ml" in -# 1106 "parsing/parser.mly" +# 1109 "parsing/parser.mly" ( _1 ) -# 45101 "parsing/parser.ml" +# 45104 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45141,15 +45144,15 @@ module Tables = struct let _startpos = _startpos_e_ in let _endpos = _endpos__2_ in let _v : ( -# 783 "parsing/parser.mly" +# 786 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 45147 "parsing/parser.ml" +# 45150 "parsing/parser.ml" ) = let _1 = let _1 = let ys = # 260 "" ( List.flatten xss ) -# 45153 "parsing/parser.ml" +# 45156 "parsing/parser.ml" in let xs = let _1 = @@ -45157,61 +45160,61 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 45163 "parsing/parser.ml" +# 45166 "parsing/parser.ml" in -# 1304 "parsing/parser.mly" +# 1307 "parsing/parser.mly" ( mkstrexp e attrs ) -# 45168 "parsing/parser.ml" +# 45171 "parsing/parser.ml" in -# 827 "parsing/parser.mly" +# 830 "parsing/parser.mly" ( Ptop_def [_1] ) -# 45174 "parsing/parser.ml" +# 45177 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 825 "parsing/parser.mly" +# 828 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 45182 "parsing/parser.ml" +# 45185 "parsing/parser.ml" in -# 885 "parsing/parser.mly" +# 888 "parsing/parser.mly" ( x ) -# 45188 "parsing/parser.ml" +# 45191 "parsing/parser.ml" in -# 1113 "parsing/parser.mly" +# 1116 "parsing/parser.mly" ( _1 ) -# 45194 "parsing/parser.ml" +# 45197 "parsing/parser.ml" in # 267 "" ( xs @ ys ) -# 45200 "parsing/parser.ml" +# 45203 "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" +# 812 "parsing/parser.mly" ( extra_def _startpos _endpos _1 ) -# 45209 "parsing/parser.ml" +# 45212 "parsing/parser.ml" in -# 1106 "parsing/parser.mly" +# 1109 "parsing/parser.mly" ( _1 ) -# 45215 "parsing/parser.ml" +# 45218 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45248,9 +45251,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Asttypes.label) = -# 3430 "parsing/parser.mly" +# 3433 "parsing/parser.mly" ( _2 ) -# 45254 "parsing/parser.ml" +# 45257 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45289,9 +45292,9 @@ module Tables = struct let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 3431 "parsing/parser.mly" +# 3434 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 45295 "parsing/parser.ml" +# 45298 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45322,9 +45325,9 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Asttypes.label) = let _loc__2_ = (_startpos__2_, _endpos__2_) in -# 3432 "parsing/parser.mly" +# 3435 "parsing/parser.mly" ( expecting _loc__2_ "operator" ) -# 45328 "parsing/parser.ml" +# 45331 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45362,9 +45365,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 3433 "parsing/parser.mly" +# 3436 "parsing/parser.mly" ( expecting _loc__3_ "module-expr" ) -# 45368 "parsing/parser.ml" +# 45371 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45383,17 +45386,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 45389 "parsing/parser.ml" +# 45392 "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) = -# 3436 "parsing/parser.mly" +# 3439 "parsing/parser.mly" ( _1 ) -# 45397 "parsing/parser.ml" +# 45400 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45416,9 +45419,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.label) = -# 3437 "parsing/parser.mly" +# 3440 "parsing/parser.mly" ( _1 ) -# 45422 "parsing/parser.ml" +# 45425 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45441,9 +45444,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3505 "parsing/parser.mly" +# 3508 "parsing/parser.mly" ( _1 ) -# 45447 "parsing/parser.ml" +# 45450 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45488,9 +45491,9 @@ module Tables = struct let ty : (Parsetree.core_type) = Obj.magic ty in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 45494 "parsing/parser.ml" +# 45497 "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 @@ -45502,33 +45505,33 @@ module Tables = struct Parsetree.attributes) = let label = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 45508 "parsing/parser.ml" +# 45511 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45516 "parsing/parser.ml" +# 45519 "parsing/parser.ml" in let attrs = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 45522 "parsing/parser.ml" +# 45525 "parsing/parser.ml" in let _1 = -# 3641 "parsing/parser.mly" +# 3644 "parsing/parser.mly" ( Fresh ) -# 45527 "parsing/parser.ml" +# 45530 "parsing/parser.ml" in -# 1855 "parsing/parser.mly" +# 1858 "parsing/parser.mly" ( (label, mutable_, Cfk_virtual ty), attrs ) -# 45532 "parsing/parser.ml" +# 45535 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45573,9 +45576,9 @@ module Tables = struct let _6 : (Parsetree.expression) = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 45579 "parsing/parser.ml" +# 45582 "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 @@ -45587,33 +45590,33 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 45593 "parsing/parser.ml" +# 45596 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45601 "parsing/parser.ml" +# 45604 "parsing/parser.ml" in let _2 = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 45607 "parsing/parser.ml" +# 45610 "parsing/parser.ml" in let _1 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 45612 "parsing/parser.ml" +# 45615 "parsing/parser.ml" in -# 1857 "parsing/parser.mly" +# 1860 "parsing/parser.mly" ( (_4, _3, Cfk_concrete (_1, _6)), _2 ) -# 45617 "parsing/parser.ml" +# 45620 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45664,9 +45667,9 @@ module Tables = struct let _6 : (Parsetree.expression) = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 647 "parsing/parser.mly" +# 650 "parsing/parser.mly" (string) -# 45670 "parsing/parser.ml" +# 45673 "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 @@ -45679,36 +45682,36 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 45685 "parsing/parser.ml" +# 45688 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45693 "parsing/parser.ml" +# 45696 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 45701 "parsing/parser.ml" +# 45704 "parsing/parser.ml" in let _1 = -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 45707 "parsing/parser.ml" +# 45710 "parsing/parser.ml" in -# 1857 "parsing/parser.mly" +# 1860 "parsing/parser.mly" ( (_4, _3, Cfk_concrete (_1, _6)), _2 ) -# 45712 "parsing/parser.ml" +# 45715 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45760,9 +45763,9 @@ module Tables = struct 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" +# 650 "parsing/parser.mly" (string) -# 45766 "parsing/parser.ml" +# 45769 "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 @@ -45774,30 +45777,30 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 45780 "parsing/parser.ml" +# 45783 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45788 "parsing/parser.ml" +# 45791 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined1_ in let _2 = -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 45795 "parsing/parser.ml" +# 45798 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in let _1 = -# 3644 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( Fresh ) -# 45801 "parsing/parser.ml" +# 45804 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in let _endpos = _endpos__7_ in @@ -45813,11 +45816,11 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1860 "parsing/parser.mly" +# 1863 "parsing/parser.mly" ( let e = mkexp_constraint ~loc:_sloc _7 _5 in (_4, _3, Cfk_concrete (_1, e)), _2 ) -# 45821 "parsing/parser.ml" +# 45824 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45875,9 +45878,9 @@ module Tables = struct 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" +# 650 "parsing/parser.mly" (string) -# 45881 "parsing/parser.ml" +# 45884 "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 @@ -45890,33 +45893,33 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3404 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ( _1 ) -# 45896 "parsing/parser.ml" +# 45899 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45904 "parsing/parser.ml" +# 45907 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 45913 "parsing/parser.ml" +# 45916 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in let _1 = -# 3645 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( Override ) -# 45920 "parsing/parser.ml" +# 45923 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = if _startpos__1_ != _endpos__1_ then @@ -45931,11 +45934,11 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1860 "parsing/parser.mly" +# 1863 "parsing/parser.mly" ( let e = mkexp_constraint ~loc:_sloc _7 _5 in (_4, _3, Cfk_concrete (_1, e)), _2 ) -# 45939 "parsing/parser.ml" +# 45942 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46002,9 +46005,9 @@ module Tables = struct let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3738 "parsing/parser.mly" +# 3741 "parsing/parser.mly" ( _1 ) -# 46008 "parsing/parser.ml" +# 46011 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -46014,30 +46017,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46020 "parsing/parser.ml" +# 46023 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3742 "parsing/parser.mly" +# 3745 "parsing/parser.mly" ( _1 ) -# 46028 "parsing/parser.ml" +# 46031 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2787 "parsing/parser.mly" +# 2790 "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 ) -# 46041 "parsing/parser.ml" +# 46044 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46053,9 +46056,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.virtual_flag) = -# 3605 "parsing/parser.mly" +# 3608 "parsing/parser.mly" ( Concrete ) -# 46059 "parsing/parser.ml" +# 46062 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46078,9 +46081,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.virtual_flag) = -# 3606 "parsing/parser.mly" +# 3609 "parsing/parser.mly" ( Virtual ) -# 46084 "parsing/parser.ml" +# 46087 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46103,9 +46106,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag) = -# 3629 "parsing/parser.mly" +# 3632 "parsing/parser.mly" ( Immutable ) -# 46109 "parsing/parser.ml" +# 46112 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46135,9 +46138,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag) = -# 3630 "parsing/parser.mly" +# 3633 "parsing/parser.mly" ( Mutable ) -# 46141 "parsing/parser.ml" +# 46144 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46167,9 +46170,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag) = -# 3631 "parsing/parser.mly" +# 3634 "parsing/parser.mly" ( Mutable ) -# 46173 "parsing/parser.ml" +# 46176 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46192,9 +46195,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag) = -# 3636 "parsing/parser.mly" +# 3639 "parsing/parser.mly" ( Public ) -# 46198 "parsing/parser.ml" +# 46201 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46224,9 +46227,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag) = -# 3637 "parsing/parser.mly" +# 3640 "parsing/parser.mly" ( Private ) -# 46230 "parsing/parser.ml" +# 46233 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46256,9 +46259,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag) = -# 3638 "parsing/parser.mly" +# 3641 "parsing/parser.mly" ( Private ) -# 46262 "parsing/parser.ml" +# 46265 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46320,27 +46323,27 @@ module Tables = struct let xs = # 253 "" ( List.rev xs ) -# 46324 "parsing/parser.ml" +# 46327 "parsing/parser.ml" in -# 897 "parsing/parser.mly" +# 900 "parsing/parser.mly" ( xs ) -# 46329 "parsing/parser.ml" +# 46332 "parsing/parser.ml" in -# 2887 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( _1 ) -# 46335 "parsing/parser.ml" +# 46338 "parsing/parser.ml" in let _endpos__6_ = _endpos_xs_ in let _5 = let _1 = _1_inlined2 in -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 46344 "parsing/parser.ml" +# 46347 "parsing/parser.ml" in let _3 = @@ -46349,16 +46352,16 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46355 "parsing/parser.ml" +# 46358 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3123 "parsing/parser.mly" +# 3126 "parsing/parser.mly" ( let lident = loc_last _3 in Pwith_type (_3, @@ -46368,7 +46371,7 @@ module Tables = struct ~manifest:_5 ~priv:_4 ~loc:(make_loc _sloc))) ) -# 46372 "parsing/parser.ml" +# 46375 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46421,9 +46424,9 @@ module Tables = struct let _v : (Parsetree.with_constraint) = let _5 = let _1 = _1_inlined2 in -# 3200 "parsing/parser.mly" +# 3203 "parsing/parser.mly" ( _1 ) -# 46427 "parsing/parser.ml" +# 46430 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined2_ in @@ -46433,16 +46436,16 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46439 "parsing/parser.ml" +# 46442 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3136 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( let lident = loc_last _3 in Pwith_typesubst (_3, @@ -46450,7 +46453,7 @@ module Tables = struct ~params:_2 ~manifest:_5 ~loc:(make_loc _sloc))) ) -# 46454 "parsing/parser.ml" +# 46457 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46499,9 +46502,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46505 "parsing/parser.ml" +# 46508 "parsing/parser.ml" in let _2 = @@ -46510,15 +46513,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46516 "parsing/parser.ml" +# 46519 "parsing/parser.ml" in -# 3144 "parsing/parser.mly" +# 3147 "parsing/parser.mly" ( Pwith_module (_2, _4) ) -# 46522 "parsing/parser.ml" +# 46525 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46567,9 +46570,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46573 "parsing/parser.ml" +# 46576 "parsing/parser.ml" in let _2 = @@ -46578,15 +46581,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 816 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 46584 "parsing/parser.ml" +# 46587 "parsing/parser.ml" in -# 3146 "parsing/parser.mly" +# 3149 "parsing/parser.mly" ( Pwith_modsubst (_2, _4) ) -# 46590 "parsing/parser.ml" +# 46593 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46609,9 +46612,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag) = -# 3149 "parsing/parser.mly" +# 3152 "parsing/parser.mly" ( Public ) -# 46615 "parsing/parser.ml" +# 46618 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46641,9 +46644,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag) = -# 3150 "parsing/parser.mly" +# 3153 "parsing/parser.mly" ( Private ) -# 46647 "parsing/parser.ml" +# 46650 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -46672,105 +46675,105 @@ end let use_file = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1809 lexer lexbuf) : ( -# 783 "parsing/parser.mly" +# 786 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 46678 "parsing/parser.ml" +# 46681 "parsing/parser.ml" )) and toplevel_phrase = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1789 lexer lexbuf) : ( -# 781 "parsing/parser.mly" +# 784 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 46686 "parsing/parser.ml" +# 46689 "parsing/parser.ml" )) and parse_val_longident = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1783 lexer lexbuf) : ( -# 793 "parsing/parser.mly" +# 796 "parsing/parser.mly" (Longident.t) -# 46694 "parsing/parser.ml" +# 46697 "parsing/parser.ml" )) and parse_pattern = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1779 lexer lexbuf) : ( -# 789 "parsing/parser.mly" +# 792 "parsing/parser.mly" (Parsetree.pattern) -# 46702 "parsing/parser.ml" +# 46705 "parsing/parser.ml" )) and parse_mty_longident = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1775 lexer lexbuf) : ( -# 795 "parsing/parser.mly" +# 798 "parsing/parser.mly" (Longident.t) -# 46710 "parsing/parser.ml" +# 46713 "parsing/parser.ml" )) and parse_mod_longident = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1771 lexer lexbuf) : ( -# 799 "parsing/parser.mly" +# 802 "parsing/parser.mly" (Longident.t) -# 46718 "parsing/parser.ml" +# 46721 "parsing/parser.ml" )) and parse_mod_ext_longident = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1767 lexer lexbuf) : ( -# 797 "parsing/parser.mly" +# 800 "parsing/parser.mly" (Longident.t) -# 46726 "parsing/parser.ml" +# 46729 "parsing/parser.ml" )) and parse_expression = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1763 lexer lexbuf) : ( -# 787 "parsing/parser.mly" +# 790 "parsing/parser.mly" (Parsetree.expression) -# 46734 "parsing/parser.ml" +# 46737 "parsing/parser.ml" )) and parse_core_type = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1759 lexer lexbuf) : ( -# 785 "parsing/parser.mly" +# 788 "parsing/parser.mly" (Parsetree.core_type) -# 46742 "parsing/parser.ml" +# 46745 "parsing/parser.ml" )) and parse_constr_longident = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1755 lexer lexbuf) : ( -# 791 "parsing/parser.mly" +# 794 "parsing/parser.mly" (Longident.t) -# 46750 "parsing/parser.ml" +# 46753 "parsing/parser.ml" )) and parse_any_longident = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1737 lexer lexbuf) : ( -# 801 "parsing/parser.mly" +# 804 "parsing/parser.mly" (Longident.t) -# 46758 "parsing/parser.ml" +# 46761 "parsing/parser.ml" )) and interface = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 1733 lexer lexbuf) : ( -# 779 "parsing/parser.mly" +# 782 "parsing/parser.mly" (Parsetree.signature) -# 46766 "parsing/parser.ml" +# 46769 "parsing/parser.ml" )) and implementation = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 0 lexer lexbuf) : ( -# 777 "parsing/parser.mly" +# 780 "parsing/parser.mly" (Parsetree.structure) -# 46774 "parsing/parser.ml" +# 46777 "parsing/parser.ml" )) module Incremental = struct @@ -46778,115 +46781,115 @@ module Incremental = struct let use_file = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1809 initial_position) : ( -# 783 "parsing/parser.mly" +# 786 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 46784 "parsing/parser.ml" +# 46787 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and toplevel_phrase = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1789 initial_position) : ( -# 781 "parsing/parser.mly" +# 784 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 46792 "parsing/parser.ml" +# 46795 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_val_longident = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1783 initial_position) : ( -# 793 "parsing/parser.mly" +# 796 "parsing/parser.mly" (Longident.t) -# 46800 "parsing/parser.ml" +# 46803 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_pattern = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1779 initial_position) : ( -# 789 "parsing/parser.mly" +# 792 "parsing/parser.mly" (Parsetree.pattern) -# 46808 "parsing/parser.ml" +# 46811 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_mty_longident = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1775 initial_position) : ( -# 795 "parsing/parser.mly" +# 798 "parsing/parser.mly" (Longident.t) -# 46816 "parsing/parser.ml" +# 46819 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_mod_longident = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1771 initial_position) : ( -# 799 "parsing/parser.mly" +# 802 "parsing/parser.mly" (Longident.t) -# 46824 "parsing/parser.ml" +# 46827 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_mod_ext_longident = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1767 initial_position) : ( -# 797 "parsing/parser.mly" +# 800 "parsing/parser.mly" (Longident.t) -# 46832 "parsing/parser.ml" +# 46835 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_expression = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1763 initial_position) : ( -# 787 "parsing/parser.mly" +# 790 "parsing/parser.mly" (Parsetree.expression) -# 46840 "parsing/parser.ml" +# 46843 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_core_type = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1759 initial_position) : ( -# 785 "parsing/parser.mly" +# 788 "parsing/parser.mly" (Parsetree.core_type) -# 46848 "parsing/parser.ml" +# 46851 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_constr_longident = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1755 initial_position) : ( -# 791 "parsing/parser.mly" +# 794 "parsing/parser.mly" (Longident.t) -# 46856 "parsing/parser.ml" +# 46859 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_any_longident = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1737 initial_position) : ( -# 801 "parsing/parser.mly" +# 804 "parsing/parser.mly" (Longident.t) -# 46864 "parsing/parser.ml" +# 46867 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and interface = fun initial_position -> (Obj.magic (MenhirInterpreter.start 1733 initial_position) : ( -# 779 "parsing/parser.mly" +# 782 "parsing/parser.mly" (Parsetree.signature) -# 46872 "parsing/parser.ml" +# 46875 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and implementation = fun initial_position -> (Obj.magic (MenhirInterpreter.start 0 initial_position) : ( -# 777 "parsing/parser.mly" +# 780 "parsing/parser.mly" (Parsetree.structure) -# 46880 "parsing/parser.ml" +# 46883 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) end -# 3772 "parsing/parser.mly" +# 3775 "parsing/parser.mly" -# 46888 "parsing/parser.ml" +# 46891 "parsing/parser.ml" # 269 "" -# 46893 "parsing/parser.ml" +# 46896 "parsing/parser.ml" diff --git a/boot/ocamlc b/boot/ocamlc index 6bcfb6346..8a1e287b1 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamllex b/boot/ocamllex index e353edbc5..9a1af6c67 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/configure b/configure index 10fe8cd84..2209a2ea1 100755 --- a/configure +++ b/configure @@ -2310,6 +2310,52 @@ rm -f conftest.val } # ac_fn_c_compute_int +# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES +# --------------------------------------------- +# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# accordingly. +ac_fn_c_check_decl () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + as_decl_name=`echo $2|sed 's/ *(.*//'` + as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 +$as_echo_n "checking whether $as_decl_name is declared... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +#ifndef $as_decl_name +#ifdef __cplusplus + (void) $as_decl_use; +#else + (void) $as_decl_name; +#endif +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + 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_decl + # ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES # ---------------------------------------------------- # Tries to find if the field MEMBER exists in type AGGR, after including @@ -2734,7 +2780,11 @@ programs_man_section=1 libraries_man_section=3 # Command to build executalbes -mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)" +# In general this command is supposed to use the CFLAGs-related variables +# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into +# account on Windows, because flexlink, which is used to build +# executables on this platform, can not handle them. +mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)" # Flags for building executable files with debugging symbols mkexedebugflag="-g" @@ -2761,7 +2811,7 @@ instrumented_runtime_ldlibs="" ## Source directory -## Directory containing auxiliary scripts used dugring build +## Directory containing auxiliary scripts used during build ac_aux_dir= for ac_dir in build-aux "$srcdir"/build-aux; do if test -f "$ac_dir/install-sh"; then @@ -3414,10 +3464,14 @@ esac fi # libtool expects host_os=mingw for native Windows +# Also, it has been observed that, on some platforms (e.g. msvc) LT_INIT +# alters the CFLAGS variable, so we save its value before calling the macro +# and restore it after the call old_host_os=$host_os if test x"$host_os" = "xwindows"; then : host_os=mingw fi +saved_CFLAGS="$CFLAGS" case `pwd` in *\ * | *\ *) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 @@ -12263,6 +12317,7 @@ CC=$lt_save_CC # Only expand once: +CFLAGS="$saved_CFLAGS" host_os=$old_host_os case $host in #( @@ -12681,7 +12736,7 @@ $as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;}; internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE=" internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #( xlc-*) : - common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS"; + common_cflags="-O5 -qtune=balanced -qnoipa -qinline"; internal_cflags="$cc_warnings" ;; #( *) : common_cflags="-O" ;; @@ -13668,6 +13723,10 @@ if test x"$enable_shared" != "xno"; then : natdynlink=true ;; #( x86_64-*-linux*) : natdynlink=true ;; #( + arm64-*-darwin*) : + natdynlink=true ;; #( + aarch64-*-darwin*) : + natdynlink=true ;; #( x86_64-*-darwin*) : natdynlink=true ;; #( s390x*-*-linux*) : @@ -13865,6 +13924,10 @@ fi; system=elf ;; #( arch=amd64; system=netbsd ;; #( x86_64-*-openbsd*) : arch=amd64; system=openbsd ;; #( + arm64-*-darwin*) : + arch=arm64; system=macosx ;; #( + aarch64-*-darwin*) : + arch=arm64; system=macosx ;; #( x86_64-*-darwin*) : arch=amd64; system=macosx ;; #( x86_64-*-mingw32) : @@ -14621,6 +14684,14 @@ if test "x$ac_cv_func_getcwd" = xyes; then : fi +ac_fn_c_check_decl "$LINENO" "system" "ac_cv_have_decl_system" "#include +" +if test "x$ac_cv_have_decl_system" = xyes; then : + $as_echo "#define HAS_SYSTEM 1" >>confdefs.h + +fi + + ## utime ## Note: this was defined in config/s-nt.h but the autoconf macros do not # seem to detect it properly on Windows so we hardcode the definition @@ -16918,8 +16989,8 @@ fi oc_cflags="$common_cflags $internal_cflags" oc_cppflags="$common_cppflags $internal_cppflags" -ocamlc_cflags="$common_cflags $sharedlib_cflags" -ocamlc_cppflags="$common_cppflags" +ocamlc_cflags="$common_cflags $sharedlib_cflags \$(CFLAGS)" +ocamlc_cppflags="$common_cppflags \$(CPPFLAGS)" cclibs="$cclibs $mathlib" case $host in #( diff --git a/configure.ac b/configure.ac index cce3129fd..cddb970f7 100644 --- a/configure.ac +++ b/configure.ac @@ -37,7 +37,11 @@ programs_man_section=1 libraries_man_section=3 # Command to build executalbes -mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)" +# In general this command is supposed to use the CFLAGs-related variables +# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into +# account on Windows, because flexlink, which is used to build +# executables on this platform, can not handle them. +mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)" # Flags for building executable files with debugging symbols mkexedebugflag="-g" @@ -64,7 +68,7 @@ instrumented_runtime_ldlibs="" ## Source directory AC_CONFIG_SRCDIR([runtime/interp.c]) -## Directory containing auxiliary scripts used dugring build +## Directory containing auxiliary scripts used during build AC_CONFIG_AUX_DIR([build-aux]) ## Output variables @@ -406,9 +410,14 @@ AS_IF([test x"$enable_unix_lib" = "xno" -o x"$enable_str_lib" = "xno"], # User-specified LD still takes precedence. AC_CHECK_TOOLS([LD],[ld link]) # libtool expects host_os=mingw for native Windows +# Also, it has been observed that, on some platforms (e.g. msvc) LT_INIT +# alters the CFLAGS variable, so we save its value before calling the macro +# and restore it after the call old_host_os=$host_os AS_IF([test x"$host_os" = "xwindows"],[host_os=mingw]) +saved_CFLAGS="$CFLAGS" LT_INIT +CFLAGS="$saved_CFLAGS" host_os=$old_host_os AS_CASE([$host], @@ -628,7 +637,7 @@ AS_CASE([$host], internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE=" internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"], [xlc-*], - [common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS"; + [common_cflags="-O5 -qtune=balanced -qnoipa -qinline"; internal_cflags="$cc_warnings"], [common_cflags="-O"])]) @@ -871,6 +880,8 @@ AS_IF([test x"$enable_shared" != "xno"], [[i[3456]86-*-linux*]], [natdynlink=true], [[i[3456]86-*-gnu*]], [natdynlink=true], [[x86_64-*-linux*]], [natdynlink=true], + [arm64-*-darwin*], [natdynlink=true], + [aarch64-*-darwin*], [natdynlink=true], [x86_64-*-darwin*], [natdynlink=true], [s390x*-*-linux*], [natdynlink=true], [powerpc*-*-linux*], [natdynlink=true], @@ -977,6 +988,10 @@ AS_CASE([$host], [arch=amd64; system=netbsd], [x86_64-*-openbsd*], [arch=amd64; system=openbsd], + [arm64-*-darwin*], + [arch=arm64; system=macosx], + [aarch64-*-darwin*], + [arch=arm64; system=macosx], [x86_64-*-darwin*], [arch=amd64; system=macosx], [x86_64-*-mingw32], @@ -1314,6 +1329,8 @@ AC_CHECK_FUNC([mkfifo], [AC_DEFINE([HAS_MKFIFO])]) AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD])]) +AC_CHECK_DECL([system], [AC_DEFINE([HAS_SYSTEM])], [], [[#include ]]) + ## 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 @@ -1843,8 +1860,8 @@ AS_IF([test x"$DEFAULT_STRING" = "xunsafe"], oc_cflags="$common_cflags $internal_cflags" oc_cppflags="$common_cppflags $internal_cppflags" -ocamlc_cflags="$common_cflags $sharedlib_cflags" -ocamlc_cppflags="$common_cppflags" +ocamlc_cflags="$common_cflags $sharedlib_cflags \$(CFLAGS)" +ocamlc_cppflags="$common_cppflags \$(CPPFLAGS)" cclibs="$cclibs $mathlib" AS_CASE([$host], diff --git a/debugger/Makefile b/debugger/Makefile index 1f94e74af..3620fa88a 100644 --- a/debugger/Makefile +++ b/debugger/Makefile @@ -27,7 +27,6 @@ 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 diff --git a/debugger/time_travel.ml b/debugger/time_travel.ml index 4d3252fb1..83cf23f40 100644 --- a/debugger/time_travel.ml +++ b/debugger/time_travel.ml @@ -181,7 +181,7 @@ let new_checkpoint_list checkpoint_count accepted rejected = 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, + (List.merge (fun t1 t2 -> compare t2.c_time t1.c_time) accepted k, l) (* Clean the checkpoint list. *) diff --git a/driver/compenv.ml b/driver/compenv.ml index f27b377d6..6f587f268 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -458,17 +458,18 @@ let read_one_param ppf position name v = 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) + if s <> "" then + 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 *) diff --git a/lambda/simplif.ml b/lambda/simplif.ml index a7e4141bd..72e2bc9a0 100644 --- a/lambda/simplif.ml +++ b/lambda/simplif.ml @@ -615,7 +615,7 @@ let rec emit_tail_infos is_tail lambda = | Default_tailcall -> () | Should_be_tailcall -> (* Note: we may want to instead check the call_kind, - which takes [is_tail_native_heuristic] into accout. + which takes [is_tail_native_heuristic] into account. But then this means getting different warnings depending on whether the native or bytecode compiler is used. *) if not is_tail diff --git a/lambda/translcore.ml b/lambda/translcore.ml index edf66f255..c195b7656 100644 --- a/lambda/translcore.ml +++ b/lambda/translcore.ml @@ -733,25 +733,53 @@ and transl_apply ~scopes sargs) : Lambda.lambda) -and transl_function0 - ~scopes loc return untuplify_fn max_arity +and transl_curried_function + ~scopes loc return + repr partial (param:Ident.t) cases = + let max_arity = Lambda.max_arity () in + let rec loop ~scopes loc return ~arity 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 = cases'; + partial = partial'; }; exp_env; exp_type;exp_loc}}] + when arity < max_arity -> + if Parmatch.inactive ~partial pat + then + 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) = + loop ~scopes exp_loc return_kind ~arity:(arity + 1) + partial' param' cases' + in + ((Curried, (param, kind) :: params, return), + Matching.for_function ~scopes loc None (Lvar param) + [pat, body] partial) + else begin + begin match partial with + | Total -> + Location.prerr_warning pat.pat_loc + Match_on_mutable_state_prevent_uncurry + | Partial -> () + end; + transl_tupled_function ~scopes ~arity + loc return repr partial param cases + end + | cases -> + transl_tupled_function ~scopes ~arity + loc return repr partial param cases + in + loop ~scopes loc return ~arity:1 partial param cases + +and transl_tupled_function + ~scopes ~arity loc return 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 max_arity > 1 && 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 (max_arity - 1) - 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 && List.length pl <= max_arity -> + when !Clflags.native_code + && arity = 1 + && List.length pl <= (Lambda.max_arity ()) -> begin try let size = List.length pl in let pats_expr_list = @@ -783,28 +811,30 @@ and transl_function0 ((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) + with Matching.Cannot_flatten -> + transl_function0 ~scopes loc return repr partial param cases end - | {c_lhs=pat} :: other_cases -> - let kind = + | _ -> transl_function0 ~scopes loc return repr partial param cases + +and transl_function0 + ~scopes loc return + repr partial (param:Ident.t) cases = + let kind = + match cases with + | [] -> + (* With Camlp4, a pattern matching might be empty *) + Pgenval + | {c_lhs=pat} :: other_cases -> (* 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)) + 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) + in + ((Curried, [param, kind], 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) = @@ -812,8 +842,7 @@ and transl_function ~scopes e param cases partial = (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 (Lambda.max_arity()) + transl_curried_function ~scopes e.exp_loc return_kind repr partial param pl) in let attr = default_function_attribute in @@ -1107,8 +1136,7 @@ and transl_letop ~scopes loc env let_ ands param case partial = 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 (Lambda.max_arity()) + transl_curried_function ~scopes case.c_rhs.exp_loc return_kind repr partial param [case]) in let attr = default_function_attribute in diff --git a/lex/Makefile b/lex/Makefile index c928d737d..5f6b16557 100644 --- a/lex/Makefile +++ b/lex/Makefile @@ -27,7 +27,6 @@ CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -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 @@ -56,7 +55,7 @@ clean:: rm -f *.cmo *.cmi *.cmx *.cmt *.cmti *.o *.obj parser.ml parser.mli: parser.mly - $(CAMLYACC) $(YACCFLAGS) parser.mly + $(CAMLYACC) -v parser.mly clean:: rm -f parser.ml parser.mli parser.output diff --git a/man/ocamlc.m b/man/ocamlc.m index 3f2b387d5..b0608d440 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -960,6 +960,10 @@ mutually recursive types. 67 \ \ Unused functor parameter. +68 +\ \ Pattern-matching depending on mutable state prevents the remaining +arguments from being uncurried. + The letters stand for the following sets of warnings. Any letter not mentioned here corresponds to the empty set. @@ -1013,7 +1017,7 @@ mentioned here corresponds to the empty set. .IP The default setting is -.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66 . +.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66\-67\-68 . Note that warnings .BR 5 \ and \ 10 are not always triggered, depending on the internals of the type checker. diff --git a/manual/manual/library/stdlib-blurb.etex b/manual/manual/library/stdlib-blurb.etex index 069af2fc9..78ac7ee66 100644 --- a/manual/manual/library/stdlib-blurb.etex +++ b/manual/manual/library/stdlib-blurb.etex @@ -46,6 +46,7 @@ the above 4 modules \\ "Int" & p.~\pageref{Int} & integer values \\ "Option" & p.~\pageref{Option} & option values \\ "Result" & p.~\pageref{Result} & result values \\ +"Either" & p.~\pageref{Either} & either 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 \\ diff --git a/manual/manual/tutorials/lablexamples.etex b/manual/manual/tutorials/lablexamples.etex index 773f0ecf0..a83c9c53d 100644 --- a/manual/manual/tutorials/lablexamples.etex +++ b/manual/manual/tutorials/lablexamples.etex @@ -42,7 +42,7 @@ 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 +respective labels\footnote{This corresponds 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 diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 9e4d1e445..d52dee893 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -388,8 +388,14 @@ module Analyser = | Cstr_record l -> Cstr_record (List.map (get_field env name_comment_list) l) in + let vc_name = match constructor_name with + | "::" -> + (* The only infix constructor is always printed (::) *) + "(::)" + | s -> s + in { - vc_name = constructor_name ; + vc_name; vc_args; vc_ret = Option.map (Odoc_env.subst_type env) ret_type; vc_text = comment_opt diff --git a/ocamltest/.depend b/ocamltest/.depend index 1ef3922a8..83262d556 100644 --- a/ocamltest/.depend +++ b/ocamltest/.depend @@ -346,12 +346,20 @@ ocamltest_config.cmx : \ ocamltest_config.cmi ocamltest_config.cmi : ocamltest_stdlib.cmo : \ + ocamltest_unix.cmi \ ocamltest_config.cmi \ ocamltest_stdlib.cmi ocamltest_stdlib.cmx : \ + ocamltest_unix.cmx \ ocamltest_config.cmx \ ocamltest_stdlib.cmi -ocamltest_stdlib.cmi : +ocamltest_stdlib.cmi : \ + ocamltest_unix.cmi +ocamltest_unix.cmo : \ + ocamltest_unix.cmi +ocamltest_unix.cmx : \ + ocamltest_unix.cmi +ocamltest_unix.cmi : options.cmo : \ variables.cmi \ tests.cmi \ diff --git a/ocamltest/Makefile b/ocamltest/Makefile index a7cecf08a..ec1ac4cbd 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -33,8 +33,16 @@ else endif ifeq "$(filter $(UNIXLIB),$(OTHERLIBRARIES))" "" + ocamltest_unix := dummy + unix_name := + unix_path := unix := None + unix_include := else + ocamltest_unix := real + unix_name := unix + unix_path := $(ROOTDIR)/otherlibs/$(UNIXLIB) + unix_include := -I $(unix_path) $(EMPTY) ifeq "$(UNIX_OR_WIN32)" "win32" unix := Some false else @@ -97,8 +105,8 @@ endif core := \ $(run_source) run_stubs.c \ - ocamltest_stdlib_stubs.c \ ocamltest_config.mli ocamltest_config.ml.in \ + ocamltest_unix.mli ocamltest_unix.ml \ ocamltest_stdlib.mli ocamltest_stdlib.ml \ run_command.mli run_command.ml \ filecompare.mli filecompare.ml \ @@ -166,6 +174,7 @@ parsers := $(filter %.mly,$(sources)) config_files := $(filter %.ml.in,$(sources)) dependencies_generated_prereqs := \ + ocamltest_unix.ml \ $(config_files:.ml.in=.ml) \ $(lexers:.mll=.ml) \ $(parsers:.mly=.mli) $(parsers:.mly=.ml) @@ -185,9 +194,9 @@ 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) +ocamlc = $(BEST_OCAMLC) $(flags) -ocamlopt := $(BEST_OCAMLOPT) $(flags) +ocamlopt = $(BEST_OCAMLOPT) $(flags) ocamldep := $(BEST_OCAMLDEP) depflags := -slash @@ -210,26 +219,29 @@ 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)) +deps_paths=$(compdeps_paths) $(addprefix $(unix_path)/,$(unix_name)) +deps_byte=$(addsuffix .cma,$(deps_paths)) +deps_opt=$(addsuffix .cmxa,$(deps_paths)) $(eval $(call PROGRAM_SYNONYM,ocamltest)) -ocamltest$(EXE): $(compdeps_byte) $(bytecode_modules) - $(ocamlc_cmd) -custom -o $@ $^ +ocamltest_unix.%: flags+=$(unix_include) -opaque -%.cmo: %.ml $(compdeps_byte) +ocamltest$(EXE): $(deps_byte) $(bytecode_modules) + $(ocamlc_cmd) $(unix_include)-custom -o $@ $^ + +%.cmo: %.ml $(deps_byte) $(ocamlc) -c $< $(eval $(call PROGRAM_SYNONYM,ocamltest.opt)) -ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules) - $(ocamlopt_cmd) -o $@ $^ +ocamltest.opt$(EXE): $(deps_opt) $(native_modules) + $(ocamlopt_cmd) $(unix_include)-o $@ $^ -%.cmx: %.ml $(compdeps_opt) +%.cmx: %.ml $(deps_opt) $(ocamlopt) -c $< -%.cmi: %.mli $(compdeps_byte) +%.cmi: %.mli $(deps_byte) $(ocamlc) -c $< %.ml %.mli: %.mly @@ -238,6 +250,10 @@ ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules) %.ml: %.mll $(ocamllex) $(OCAMLLEX_FLAGS) $< +ocamltest_unix.ml: ocamltest_unix_$(ocamltest_unix).ml + echo '# 1 "$^"' > $@ + cat $^ >> $@ + ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config sed $(call SUBST,AFL_INSTRUMENT) \ $(call SUBST,RUNTIMEI) \ @@ -304,7 +320,7 @@ include $(addprefix $(DEPDIR)/, $(c_files:.c=.$(D))) endif $(DEPDIR)/%.$(D): %.c | $(DEPDIR) - $(DEP_CC) $(OC_CPPFLAGS) $< -MT '$*.$(O)' -MF $@ + $(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@ .PHONY: depend depend: $(dependencies_generated_prereqs) diff --git a/ocamltest/actions_helpers.ml b/ocamltest/actions_helpers.ml index 5e0b7c913..eee65752c 100644 --- a/ocamltest/actions_helpers.ml +++ b/ocamltest/actions_helpers.ml @@ -62,13 +62,25 @@ let files env = words_of_variable env Builtin_variables.files let setup_symlinks test_source_directory build_directory files = let symlink filename = + (* Emulate ln -sfT *) let src = Filename.concat test_source_directory filename in - Sys.run_system_command "ln" ["-sf"; src; build_directory] in + let dst = Filename.concat build_directory filename in + let () = + if Sys.file_exists dst then + if Sys.win32 && Sys.is_directory dst then + (* Native symbolic links to directories don't disappear with unlink; + doing rmdir here is technically slightly more than ln -sfT would + do *) + Sys.rmdir dst + else + Sys.remove dst + in + Unix.symlink src dst 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.win32 then copy else symlink in + let f = if Unix.has_symlink () then symlink else copy in Sys.make_directory build_directory; List.iter f files diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml index 2965b52bc..4baf788be 100644 --- a/ocamltest/builtin_actions.ml +++ b/ocamltest/builtin_actions.ml @@ -195,7 +195,7 @@ let naked_pointers = make let has_symlink = make "has_symlink" - (Actions_helpers.pass_or_skip (Sys.has_symlink () ) + (Actions_helpers.pass_or_skip (Unix.has_symlink () ) "symlinks available" "symlinks not available") diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml index 9bad9af3c..97d00ff33 100644 --- a/ocamltest/filecompare.ml +++ b/ocamltest/filecompare.ml @@ -59,33 +59,103 @@ type files = { output_filename : string; } -let read_text_file lines_to_drop fn = - Sys.with_input_file ~bin:true fn @@ fun ic -> - 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 -> - try List.rev_map drop_cr acc - with Exit -> List.rev acc - in - drop lines_to_drop +let last_is_cr s = + let l = String.length s in + l > 0 && s.[l - 1] = '\r' -let compare_text_files dropped_lines file1 file2 = - if read_text_file 0 file1 = read_text_file dropped_lines file2 then - Same - else - Different +(* Returns last character of an input file. Fails for an empty file. *) +let last_char ic = + seek_in ic (in_channel_length ic - 1); + input_char ic + +(* [line_seq_of_in_channel ~normalise ic first_line] constructs a sequence of + the lines of [ic] where [first_line] is the already read first line of [ic]. + Strings include the line terminator and CRLF is normalised to LF if + [normalise] is [true]. The sequence raises [Exit] if normalise is [true] and + a terminated line is encountered which does not end CRLF. The final line of + the sequence only includes a terminator if it is present in the file (and a + terminating CR is never normalised if not strictly followed by LF). *) +let line_seq_of_in_channel ~normalise ic = + let normalise = + if normalise then + fun s -> + if last_is_cr s then + String.sub s 0 (String.length s - 1) + else + raise Exit + else + Fun.id + in + let rec read_line last () = + (* Read the next line to determine if the last line ended with LF *) + match input_line ic with + | line -> + Seq.Cons (normalise last ^ "\n", read_line line) + | exception End_of_file -> + (* EOF reached - seek the last character to determine if the final + line ends in LF *) + let last = + if last_char ic = '\n' then + normalise last ^ "\n" + else + last + in + Seq.Cons (last, Seq.empty) + in + read_line + +let compare_text_files ignored_lines file1 file2 = + Sys.with_input_file ~bin:true file2 @@ fun ic2 -> + (* Get the first non-dropped line of file2 and determine if could be + CRLF-normalised (it can't be in any of the dropped lines didn't end + CRLF. *) + let (crlf_endings2, line2, reached_end_file2) = + let rec loop crlf_endings2 k = + match input_line ic2 with + | line -> + let crlf_endings2 = crlf_endings2 && last_is_cr line in + if k = 0 then + (crlf_endings2, line, false) + else + loop crlf_endings2 (pred k) + | exception End_of_file -> + (false, "", true) + in + loop true ignored_lines + in + Sys.with_input_file ~bin:true file1 @@ fun ic1 -> + if reached_end_file2 then + (* We reached the end of file2 while ignoring lines, so only an empty + file can be identical, as in the binary comparison case. *) + if in_channel_length ic1 = 0 then + Same + else + Different + else + (* file2 has at least one non-ignored line *) + match input_line ic1 with + | exception End_of_file -> Different + | line1 -> + let crlf_endings1 = last_is_cr line1 in + (* If both files appear to have CRLF endings, then there's no need + to attempt to normalise either. *) + let seq1 = + let normalise = crlf_endings1 && not crlf_endings2 in + line_seq_of_in_channel ~normalise ic1 line1 in + let seq2 = + let normalise = crlf_endings2 && not crlf_endings1 in + line_seq_of_in_channel ~normalise ic2 line2 in + try + if Seq.equal seq1 seq2 then + Same + else + raise Exit + with Exit -> + (* Either the lines weren't equal, or the file which was being + normalised suddenly had a line which didn't end CRLF. In this + case, the files must differ since only one file is ever being + normalised, so the earlier lines differed too. *) + Different (* Version of Stdlib.really_input which stops at EOF, rather than raising an exception. *) @@ -161,13 +231,15 @@ let diff files = let temporary_file = Filename.temp_file "ocamltest" "diff" in let diff_commandline = Filename.quote_command "diff" ~stdout:temporary_file - [ "-u"; + [ "--strip-trailing-cr"; "-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) + match Sys.command diff_commandline with + | 0 -> Ok "Inconsistent LF/CRLF line-endings" + | 2 -> Stdlib.Error "diff" + | _ -> Ok (Sys.string_of_file temporary_file) in Sys.force_remove temporary_file; result diff --git a/ocamltest/main.ml b/ocamltest/main.ml index 1fcdb4825..9197ce325 100644 --- a/ocamltest/main.ml +++ b/ocamltest/main.ml @@ -152,9 +152,9 @@ let test_file test_filename = 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])) + try + Sys.rm_rf test_build_directory_prefix + with Sys_error _ -> () in clean_test_build_directory (); Sys.make_directory test_build_directory_prefix; @@ -221,6 +221,8 @@ let is_test s = let ignored s = s = "" || s.[0] = '_' || s.[0] = '.' +let sort_strings = List.sort String.compare + let find_test_dirs dir = let res = ref [] in let rec loop dir = @@ -236,7 +238,7 @@ let find_test_dirs dir = if !contains_tests then res := dir :: !res in loop dir; - List.rev !res + sort_strings !res let list_tests dir = let res = ref [] in @@ -250,7 +252,7 @@ let list_tests dir = end ) (Sys.readdir dir) end; - List.rev !res + sort_strings !res let () = init_tests_to_skip() diff --git a/ocamltest/ocaml_actions.ml b/ocamltest/ocaml_actions.ml index 1e152a603..71524c0ce 100644 --- a/ocamltest/ocaml_actions.ml +++ b/ocamltest/ocaml_actions.ml @@ -977,83 +977,80 @@ let run_test_program_in_toplevel (toplevel : Ocaml_toplevels.toplevel) log env = (* 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 = + let toplevel_supports_dynamic_loading = 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 compiler = toplevel#compiler in - let compiler_name = compiler#name in - let modules_with_filetypes = - List.map Ocaml_filetypes.filetype (modules env) in - let (result, env) = compile_modules - 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 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; - directory_flags env; - Ocaml_flags.include_toplevel_directory; - 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) + match cmas_need_dynamic_loading (directories env) libraries with + | Some (Error reason) -> + (Result.fail_with_reason reason, env) + | Some (Ok ()) when not toplevel_supports_dynamic_loading -> + (Result.skip, env) + | _ -> + 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 compiler = toplevel#compiler in + let compiler_name = compiler#name in + let modules_with_filetypes = + List.map Ocaml_filetypes.filetype (modules env) in + let (result, env) = compile_modules + 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 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; + directory_flags env; + Ocaml_flags.include_toplevel_directory; + 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" diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index 15b4963a8..a6ee5319f 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -15,7 +15,7 @@ (* A few extensions to OCaml's standard library *) -(* Pervaisive *) +module Unix = Ocamltest_unix let input_line_opt ic = try Some (input_line ic) with End_of_file -> None @@ -84,22 +84,37 @@ end module Sys = struct include Sys - let run_system_command prog args = - let command = Filename.quote_command prog args in - match Sys.command command with - | 0 -> () - | _ as exitcode -> - Printf.eprintf "System command %s failed with status %d\n%!" - command exitcode; - exit 3 + let erase_file path = + try Sys.remove path + with Sys_error _ when Sys.win32 && Ocamltest_config.libunix <> None -> + (* Deal with read-only attribute on Windows. Ignore any error from chmod + so that the message always come from Sys.remove *) + let () = try Unix.chmod path 0o666 with Sys_error _ -> () in + Sys.remove path - let mkdir dir = - if not (Sys.file_exists dir) then - run_system_command "mkdir" [dir] + let rm_rf path = + let rec erase path = + if Sys.is_directory path then begin + Array.iter (fun entry -> erase (Filename.concat path entry)) + (Sys.readdir path); + Sys.rmdir path + end else erase_file path + in + try if Sys.file_exists path then erase path + with Sys_error err -> + raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err)) let rec make_directory dir = if Sys.file_exists dir then () - else (make_directory (Filename.dirname dir); mkdir dir) + else let () = make_directory (Filename.dirname dir) in + if not (Sys.file_exists dir) then + Sys.mkdir dir 0o777 + else () + + let make_directory dir = + try make_directory dir + with Sys_error err -> + raise (Sys_error (Printf.sprintf "Failed to create %S (%s)" dir err)) let with_input_file ?(bin=false) x f = let ic = (if bin then open_in_bin else open_in) x in @@ -161,8 +176,6 @@ module Sys = struct 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; @@ -172,3 +185,13 @@ module Sys = struct try Sys.getenv variable with Not_found -> default_value let safe_getenv variable = getenv_with_default_value variable "" end + +module Seq = struct + include Seq + + let rec equal s1 s2 = + match s1 (), s2 () with + | Nil, Nil -> true + | Cons(e1, s1), Cons(e2, s2) -> e1 = e2 && equal s1 s2 + | _, _ -> false +end diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index 3a75aa21d..f28bf05a3 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -46,18 +46,27 @@ end module Sys : sig include module type of Sys val file_is_empty : string -> bool - val run_system_command : string -> string list -> unit val make_directory : string -> unit + val rm_rf : string -> unit val string_of_file : string -> string val iter_lines_of_file : (string -> unit) -> string -> unit val dump_file : out_channel -> ?prefix:string -> string -> unit 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 val with_input_file : ?bin:bool -> string -> (in_channel -> 'a) -> 'a val with_output_file : ?bin:bool -> string -> (out_channel -> 'a) -> 'a end + +module Seq : sig + include module type of struct include Seq end + + val equal : 'a t -> 'a t -> bool +end + +module Unix : sig + include module type of Ocamltest_unix +end diff --git a/ocamltest/ocamltest_stdlib_stubs.c b/ocamltest/ocamltest_stdlib_stubs.c deleted file mode 100644 index d4d31a282..000000000 --- a/ocamltest/ocamltest_stdlib_stubs.c +++ /dev/null @@ -1,154 +0,0 @@ -/**************************************************************************/ -/* */ -/* 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 -#include - -#include -#include -#include -#include -/* -#include -*/ -#include -#include - - -#ifdef _WIN32 - -/* - * Windows Vista functions enabled - */ -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0600 - -#include -#include -#include -#include - -// Developer Mode allows the creation of symlinks without elevation - see -// https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-createsymboliclinkw -static BOOL IsDeveloperModeEnabled() -{ - HKEY hKey; - LSTATUS status; - DWORD developerModeRegistryValue, dwordSize = sizeof(DWORD); - - status = RegOpenKeyExW( - HKEY_LOCAL_MACHINE, - L"SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\AppModelUnlock", - 0, - KEY_READ | KEY_WOW64_64KEY, - &hKey - ); - if (status != ERROR_SUCCESS) { - return FALSE; - } - - status = RegQueryValueExW( - hKey, - L"AllowDevelopmentWithoutDevLicense", - NULL, - NULL, - (LPBYTE)&developerModeRegistryValue, - &dwordSize - ); - RegCloseKey(hKey); - if (status != ERROR_SUCCESS) { - return FALSE; - } - return developerModeRegistryValue != 0; -} - -#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 (IsDeveloperModeEnabled()) { - CAMLreturn(Val_true); - } - - 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/ocamltest_unix.mli b/ocamltest/ocamltest_unix.mli new file mode 100644 index 000000000..1a111fd9d --- /dev/null +++ b/ocamltest/ocamltest_unix.mli @@ -0,0 +1,20 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* David Allsopp, OCaml Labs, Cambridge. *) +(* *) +(* Copyright 2020 David Allsopp 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. *) +(* *) +(**************************************************************************) + +(** Functions imported from Unix. They are explicitly here to remove the + temptation to use the Unix module directly in ocamltest. *) + +val has_symlink : unit -> bool +val symlink : ?to_dir:bool -> string -> string -> unit +val chmod : string -> int -> unit diff --git a/ocamltest/ocamltest_unix_dummy.ml b/ocamltest/ocamltest_unix_dummy.ml new file mode 100644 index 000000000..32b805992 --- /dev/null +++ b/ocamltest/ocamltest_unix_dummy.ml @@ -0,0 +1,18 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* David Allsopp, OCaml Labs, Cambridge. *) +(* *) +(* Copyright 2020 David Allsopp 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. *) +(* *) +(**************************************************************************) + +(* Dummy implementations for when the Unix library isn't built *) +let has_symlink () = false +let symlink ?to_dir:_ _ _ = invalid_arg "symlink not available" +let chmod _ _ = invalid_arg "chmod not available" diff --git a/ocamltest/ocamltest_unix_real.ml b/ocamltest/ocamltest_unix_real.ml new file mode 100644 index 000000000..322b911f9 --- /dev/null +++ b/ocamltest/ocamltest_unix_real.ml @@ -0,0 +1,29 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* David Allsopp, OCaml Labs, Cambridge. *) +(* *) +(* Copyright 2020 David Allsopp 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. *) +(* *) +(**************************************************************************) + +(* Unix.has_symlink never raises *) +let has_symlink = Unix.has_symlink + +(* Convert Unix_error to Sys_error *) +let wrap f x = + try f x + with Unix.Unix_error(err, fn_name, arg) -> + let msg = + Printf.sprintf "%s failed on %S with %s" + fn_name arg (Unix.error_message err) + in + raise (Sys_error msg) + +let symlink ?to_dir source = wrap (Unix.symlink ?to_dir source) +let chmod file = wrap (Unix.chmod file) diff --git a/ocamltest/run_stubs.c b/ocamltest/run_stubs.c index 2f89e83dc..10f82c33b 100644 --- a/ocamltest/run_stubs.c +++ b/ocamltest/run_stubs.c @@ -71,8 +71,10 @@ static void logToChannel(void *voidchannel, const char *fmt, va_list ap) if (text == NULL) return; if (vsnprintf(text, length, fmt, ap) != length) goto end; } + Lock(channel); caml_putblock(channel, text, length); caml_flush(channel); + Unlock(channel); end: free(text); } diff --git a/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common index 1d43b1315..a029af560 100644 --- a/otherlibs/Makefile.otherlibs.common +++ b/otherlibs/Makefile.otherlibs.common @@ -24,6 +24,10 @@ CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib +ifneq "$(CCOMPTYPE)" "msvc" +OC_CFLAGS += -g +endif + OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS) OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(EXTRACPPFLAGS) @@ -140,4 +144,4 @@ endif endif $(DEPDIR)/%.$(D): %.c | $(DEPDIR) - $(DEP_CC) $(OC_CPPFLAGS) $< -MT '$*.$(O)' -MF $@ + $(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@ diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index 7852bc89b..2afa345a0 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -18,6 +18,10 @@ ROOTDIR=../.. include $(ROOTDIR)/Makefile.common include $(ROOTDIR)/Makefile.best_binaries +ifneq "$(CCOMPTYPE)" "msvc" +OC_CFLAGS += -g +endif + OC_CFLAGS += $(SHAREDLIB_CFLAGS) OC_CPPFLAGS += -I$(ROOTDIR)/runtime @@ -96,7 +100,8 @@ st_stubs.%.$(O): st_stubs.c else st_stubs.%.$(O): st_stubs.c $(RUNTIME_HEADERS) $(wildcard *.h) endif - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $< + $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \ + $(OUTPUTOBJ)$@ $< partialclean: rm -f *.cm* @@ -158,7 +163,7 @@ endif define GEN_RULE $(DEPDIR)/%.$(1).$(D): %.c | $(DEPDIR) - $$(DEP_CC) $$(OC_CPPFLAGS) $$< -MT '$$*.$(1).$(O)' -MF $$@ + $$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT '$$*.$(1).$(O)' -MF $$@ endef $(foreach object_type, b n, $(eval $(call GEN_RULE,$(object_type)))) diff --git a/otherlibs/systhreads/st_posix.h b/otherlibs/systhreads/st_posix.h index 17ed15141..75ceeccde 100644 --- a/otherlibs/systhreads/st_posix.h +++ b/otherlibs/systhreads/st_posix.h @@ -437,6 +437,8 @@ value caml_thread_sigmask(value cmd, value sigs) /* ML */ retcode = pthread_sigmask(how, &set, &oldset); caml_leave_blocking_section(); st_check_error(retcode, "Thread.sigmask"); + /* Run any handlers for just-unmasked pending signals */ + caml_process_pending_actions(); return st_encode_sigset(&oldset); } diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index 285466edb..9c96df54f 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -253,15 +253,6 @@ static void caml_thread_leave_blocking_section(void) 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) @@ -496,7 +487,6 @@ CAMLprim value caml_thread_initialize(value unit) /* ML */ 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 diff --git a/otherlibs/unix/channels.c b/otherlibs/unix/channels.c index ecf0cc2fa..753bf9f52 100644 --- a/otherlibs/unix/channels.c +++ b/otherlibs/unix/channels.c @@ -64,10 +64,6 @@ static int unix_check_stream_semantics(int fd) } } -/* From runtime/io.c. To be declared in ? */ -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; diff --git a/otherlibs/unix/kill.c b/otherlibs/unix/kill.c index d229d3e9e..7154e1d10 100644 --- a/otherlibs/unix/kill.c +++ b/otherlibs/unix/kill.c @@ -27,5 +27,6 @@ CAMLprim value unix_kill(value pid, value signal) sig = caml_convert_signal_number(Int_val(signal)); if (kill(Int_val(pid), sig) == -1) uerror("kill", Nothing); + caml_process_pending_actions(); return Val_unit; } diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c index 0c1777816..ff1c6ed43 100644 --- a/otherlibs/unix/mkdir.c +++ b/otherlibs/unix/mkdir.c @@ -13,9 +13,15 @@ /* */ /**************************************************************************/ +#ifndef _WIN32 #include #include +#endif + +#define CAML_INTERNALS #include +#include +#include #include #include #include "unixsupport.h" @@ -23,12 +29,12 @@ CAMLprim value unix_mkdir(value path, value perm) { CAMLparam2(path, perm); - char * p; + char_os * p; int ret; caml_unix_check_path(path, "mkdir"); - p = caml_stat_strdup(String_val(path)); + p = caml_stat_strdup_to_os(String_val(path)); caml_enter_blocking_section(); - ret = mkdir(p, Int_val(perm)); + ret = mkdir_os(p, Int_val(perm)); caml_leave_blocking_section(); caml_stat_free(p); if (ret == -1) uerror("mkdir", path); diff --git a/otherlibs/unix/mmap.c b/otherlibs/unix/mmap.c index 15465ddc6..7afab62f6 100644 --- a/otherlibs/unix/mmap.c +++ b/otherlibs/unix/mmap.c @@ -39,8 +39,7 @@ #endif /* Defined in [mmap_ba.c] */ -CAMLextern value -caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim); +extern value caml_unix_mapped_alloc(int, int, void *, intnat *); #if defined(HAS_MMAP) diff --git a/otherlibs/unix/mmap_ba.c b/otherlibs/unix/mmap_ba.c index bdb5c60f6..3e34fc725 100644 --- a/otherlibs/unix/mmap_ba.c +++ b/otherlibs/unix/mmap_ba.c @@ -24,7 +24,7 @@ /* 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); +extern void caml_ba_unmap_file(void *, uintnat); static void caml_ba_mapped_finalize(value v) { diff --git a/otherlibs/unix/signals.c b/otherlibs/unix/signals.c index ff59a7267..6e54032d6 100644 --- a/otherlibs/unix/signals.c +++ b/otherlibs/unix/signals.c @@ -71,6 +71,8 @@ CAMLprim value unix_sigprocmask(value vaction, value vset) caml_enter_blocking_section(); retcode = caml_sigmask_hook(how, &set, &oldset); caml_leave_blocking_section(); + /* Run any handlers for just-unmasked pending signals */ + caml_process_pending_actions(); if (retcode != 0) unix_error(retcode, "sigprocmask", Nothing); return encode_sigset(&oldset); } diff --git a/otherlibs/unix/sockopt.c b/otherlibs/unix/sockopt.c index d2961d09e..39340a2f3 100644 --- a/otherlibs/unix/sockopt.c +++ b/otherlibs/unix/sockopt.c @@ -38,6 +38,9 @@ #ifndef SO_REUSEADDR #define SO_REUSEADDR (-1) #endif +#ifndef SO_REUSEPORT +#define SO_REUSEPORT (-1) +#endif #ifndef SO_KEEPALIVE #define SO_KEEPALIVE (-1) #endif @@ -109,6 +112,7 @@ static struct socket_option sockopt_bool[] = { { SOL_SOCKET, SO_DEBUG }, { SOL_SOCKET, SO_BROADCAST }, { SOL_SOCKET, SO_REUSEADDR }, + { SOL_SOCKET, SO_REUSEPORT }, { SOL_SOCKET, SO_KEEPALIVE }, { SOL_SOCKET, SO_DONTROUTE }, { SOL_SOCKET, SO_OOBINLINE }, diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml index 4097be0b8..6de27bc38 100644 --- a/otherlibs/unix/unix.ml +++ b/otherlibs/unix/unix.ml @@ -597,6 +597,7 @@ type socket_bool_option = SO_DEBUG | SO_BROADCAST | SO_REUSEADDR + | SO_REUSEPORT | SO_KEEPALIVE | SO_DONTROUTE | SO_OOBINLINE diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 84f8305e2..1db17905f 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -1477,6 +1477,7 @@ 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_REUSEPORT (** Allow reuse of address and port bindings *) | SO_KEEPALIVE (** Keep connection active *) | SO_DONTROUTE (** Bypass the standard routing algorithms *) | SO_OOBINLINE (** Leave out-of-band data in line *) diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli index 36d4753b4..6289fd767 100644 --- a/otherlibs/unix/unixLabels.mli +++ b/otherlibs/unix/unixLabels.mli @@ -1477,6 +1477,7 @@ type socket_bool_option = Unix.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_REUSEPORT (** Allow reuse of address and port bindings *) | SO_KEEPALIVE (** Keep connection active *) | SO_DONTROUTE (** Bypass the standard routing algorithms *) | SO_OOBINLINE (** Leave out-of-band data in line *) diff --git a/otherlibs/win32unix/Makefile b/otherlibs/win32unix/Makefile index 08c4c2e50..f2578bcd9 100644 --- a/otherlibs/win32unix/Makefile +++ b/otherlibs/win32unix/Makefile @@ -22,7 +22,7 @@ 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 \ + 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 \ @@ -30,7 +30,7 @@ WIN_FILES = accept.c bind.c channels.c close.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 \ + cstringv.c execv.c execve.c execvp.c mkdir.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 \ diff --git a/otherlibs/win32unix/mmap.c b/otherlibs/win32unix/mmap.c index da08a19fd..1259d8d0a 100644 --- a/otherlibs/win32unix/mmap.c +++ b/otherlibs/win32unix/mmap.c @@ -30,8 +30,7 @@ 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); +extern value caml_unix_mapped_alloc(int, int, void *, intnat *); #ifndef INVALID_SET_FILE_POINTER #define INVALID_SET_FILE_POINTER (-1) diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c index 6035556f7..c0fe26024 100644 --- a/otherlibs/win32unix/sockopt.c +++ b/otherlibs/win32unix/sockopt.c @@ -21,6 +21,9 @@ #include "unixsupport.h" #include "socketaddr.h" +#ifndef SO_REUSEPORT +#define SO_REUSEPORT (-1) +#endif #ifndef IPPROTO_IPV6 #define IPPROTO_IPV6 (-1) #endif @@ -47,6 +50,7 @@ static struct socket_option sockopt_bool[] = { { SOL_SOCKET, SO_DEBUG }, { SOL_SOCKET, SO_BROADCAST }, { SOL_SOCKET, SO_REUSEADDR }, + { SOL_SOCKET, SO_REUSEPORT }, { SOL_SOCKET, SO_KEEPALIVE }, { SOL_SOCKET, SO_DONTROUTE }, { SOL_SOCKET, SO_OOBINLINE }, diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index 84bd755ec..b27b7dc5c 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -729,6 +729,7 @@ type socket_bool_option = SO_DEBUG | SO_BROADCAST | SO_REUSEADDR + | SO_REUSEPORT | SO_KEEPALIVE | SO_DONTROUTE | SO_OOBINLINE diff --git a/parsing/parse.mli b/parsing/parse.mli index 699e6badd..8669a4b6c 100644 --- a/parsing/parse.mli +++ b/parsing/parse.mli @@ -32,7 +32,7 @@ val pattern : Lexing.lexbuf -> Parsetree.pattern val longident: Lexing.lexbuf -> Longident.t (** - The function [longident] is guaranted to parse all subclasses + The function [longident] is guaranteed to parse all subclasses of {!Longident.t} used in OCaml: values, constructors, simple or extended module paths, and types or module types. diff --git a/parsing/parser.mly b/parsing/parser.mly index 5ef2957a7..b368f3649 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -427,7 +427,8 @@ 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 text_def pos = + List.map (fun def -> Ptop_def [def]) (Str.text (rhs_text pos)) let extra_text startpos endpos text items = match items with @@ -445,7 +446,9 @@ 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 + extra_text p1 p2 + (fun txt -> List.map (fun def -> Ptop_def [def]) (Str.text txt)) + items let extra_rhs_core_type ct ~pos = let docs = rhs_info pos in diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 8e50995ec..58239c87c 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -174,7 +174,7 @@ and row_field_desc = (see 4.2 in the manual) *) | Rinherit of core_type - (* [ T ] *) + (* [ | t ] *) and object_field = { pof_desc : object_field_desc; diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 9b8f1839e..442fd6d73 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -330,6 +330,9 @@ and core_type1 ctxt f x = | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l) l longident_loc li | Ptyp_variant (l, closed, low) -> + let first_is_inherit = match l with + | {Parsetree.prf_desc = Rinherit _}::_ -> true + | _ -> false in let type_variant_helper f x = match x.prf_desc with | Rtag (l, _, ctl) -> @@ -348,7 +351,7 @@ and core_type1 ctxt f x = | _ -> pp f "%s@;%a" (match (closed,low) with - | (Closed,None) -> "" + | (Closed,None) -> if first_is_inherit then " |" else "" | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*) | (Open,_) -> ">") (list type_variant_helper ~sep:"@;<1 -2>| ") l) l @@ -1584,9 +1587,9 @@ and extension_constructor ctxt f x = | 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 + pp f "%s@;=@;%a%a" x.pext_name.txt longident_loc li + (attributes ctxt) x.pext_attributes and case_list ctxt f l : unit = let aux f {pc_lhs; pc_guard; pc_rhs} = diff --git a/release-info/howto.md b/release-info/howto.md index 21d88445c..cbd9da1ab 100644 --- a/release-info/howto.md +++ b/release-info/howto.md @@ -234,6 +234,9 @@ opam switch create --repo=local,beta=git+https://github.com/ocaml/ocaml-beta-rep ``` The switch should build. +For a production release, you also need to create new opam files for the ocaml-manual and +ocaml-src packages. + ## 6.1 Update OPAM dev packages after branching Create a new ocaml/ocaml.$NEXT/opam file. diff --git a/runtime/Makefile b/runtime/Makefile index aa7853430..9cccfd069 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -349,13 +349,15 @@ ifneq "$(1)" "%" # don't use -MG and instead include $(GENERATED_HEADERS) in the order only # dependencies to ensure that they exist before dependencies are computed. $(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(GENERATED_HEADERS) - $$(DEP_CC) $$(OC_CPPFLAGS) $$< -MT '$$*$(subst %,,$(1)).$(O)' -MF $$@ + $$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT \ + '$$*$(subst %,,$(1)).$(O)' -MF $$@ endif $(1).$(O): %.c else $(1).$(O): %.c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS) endif - $$(CC) -c $$(OC_CFLAGS) $$(OC_CPPFLAGS) $$(OUTPUTOBJ)$$@ $$< + $$(CC) -c $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \ + $$(OUTPUTOBJ)$$@ $$< endef object_types := % %.b %.bd %.bi %.bpic diff --git a/runtime/alloc.c b/runtime/alloc.c index 73a8f01b1..6d3518dea 100644 --- a/runtime/alloc.c +++ b/runtime/alloc.c @@ -289,6 +289,6 @@ CAMLexport value caml_alloc_some(value v) { CAMLparam1(v); value some = caml_alloc_small(1, 0); - Store_field(some, 0, v); + Field(some, 0) = v; CAMLreturn(some); } diff --git a/runtime/arm64.S b/runtime/arm64.S index 6bad4ce87..200154f88 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -24,10 +24,9 @@ #define TRAP_PTR x26 #define ALLOC_PTR x27 #define ALLOC_LIMIT x28 -#define ARG x15 +#define ADDITIONAL_ARG x8 #define TMP x16 #define TMP2 x17 -#define ARG_DOMAIN_STATE_PTR x18 #define C_ARG_1 x0 #define C_ARG_2 x1 @@ -51,24 +50,47 @@ #endif .set domain_curr_field, 0 +#if defined(SYS_macosx) +#define DOMAIN_STATE(c_type, name) DOMAIN_STATE c_type, name + .macro DOMAIN_STATE c_type, name + .equ domain_field_caml_\name, domain_curr_field + .set domain_curr_field, domain_curr_field + 1 + .endm +#else #define DOMAIN_STATE(c_type, name) \ .equ domain_field_caml_##name, domain_curr_field ; \ .set domain_curr_field, domain_curr_field + 1 +#endif #include "../runtime/caml/domain_state.tbl" #undef DOMAIN_STATE #define Caml_state(var) [x25, 8*domain_field_caml_##var] -#if defined(__PIC__) +/* Globals and labels */ +#if defined(SYS_macosx) +#define G(sym) _##sym +#define L(lbl) L##lbl +#else +#define G(sym) sym +#define L(lbl) .L##lbl +#endif +#if defined(SYS_macosx) + +#define ADDRGLOBAL(reg,symb) ADDRGLOBAL reg, symb + .macro ADDRGLOBAL reg, symb + adrp TMP2, G(\symb)@GOTPAGE + ldr \reg, [TMP2, G(\symb)@GOTPAGEOFF] + .endm +#elif defined(__PIC__) #define ADDRGLOBAL(reg,symb) \ - adrp TMP2, :got:symb; \ - ldr reg, [TMP2, #:got_lo12:symb] + adrp TMP2, :got:G(symb); \ + ldr reg, [TMP2, #:got_lo12:G(symb)] #else #define ADDRGLOBAL(reg,symb) \ - adrp reg, symb; \ - add reg, reg, #:lo12:symb + adrp reg, G(symb); \ + add reg, reg, #:lo12:G(symb) #endif @@ -80,28 +102,62 @@ #if defined(FUNCTION_SECTIONS) TEXT_SECTION(caml_hot__code_begin) - .globl caml_hot__code_begin -caml_hot__code_begin: + .globl G(caml_hot__code_begin) +G(caml_hot__code_begin): TEXT_SECTION(caml_hot__code_end) - .globl caml_hot__code_end -caml_hot__code_end: + .globl G(caml_hot__code_end) +G(caml_hot__code_end): #endif +#if defined(SYS_macosx) + +#define FUNCTION(name) FUNCTION name + .macro FUNCTION name + TEXT_SECTION(caml.##G(\name)) + .align 2 + .globl G(\name) +G(\name): + .endm +#define END_FUNCTION(name) + +#define OBJECT(name) OBJECT name + .macro OBJECT name + .data + .align 3 + .globl G(\name) +G(\name): + .endm +#define END_OBJECT(name) + +#else + #define FUNCTION(name) \ TEXT_SECTION(caml.##name); \ - .align 2; \ - .globl name; \ - .type name, %function; \ -name: + .align 2; \ + .globl G(name); \ + .type G(name), %function; \ +G(name): +#define END_FUNCTION(name) \ + .size G(name), .-G(name) + +#define OBJECT(name) \ + .data; \ + .align 3; \ + .globl G(name); \ + .type G(name), %object; \ +G(name): +#define END_OBJECT(name) \ + .size G(name), .-G(name) +#endif /* Allocation functions and GC interface */ - .globl caml_system__code_begin -caml_system__code_begin: + .globl G(caml_system__code_begin) +G(caml_system__code_begin): FUNCTION(caml_call_gc) CFI_STARTPROC -.Lcaml_call_gc: +L(caml_call_gc): /* Record return address */ str x30, Caml_state(last_return_address) /* Record lowest stack address */ @@ -150,7 +206,7 @@ FUNCTION(caml_call_gc) /* 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 + bl G(caml_garbage_collection) /* Restore registers */ ldp x0, x1, [sp, 16] ldp x2, x3, [sp, 32] @@ -183,46 +239,46 @@ FUNCTION(caml_call_gc) ldp x29, x30, [sp], 400 ret CFI_ENDPROC - .size caml_call_gc, .-caml_call_gc + END_FUNCTION(caml_call_gc) FUNCTION(caml_alloc1) CFI_STARTPROC sub ALLOC_PTR, ALLOC_PTR, #16 cmp ALLOC_PTR, ALLOC_LIMIT - b.lo .Lcaml_call_gc + b.lo L(caml_call_gc) ret CFI_ENDPROC - .size caml_alloc1, .-caml_alloc1 + END_FUNCTION(caml_alloc1) FUNCTION(caml_alloc2) CFI_STARTPROC sub ALLOC_PTR, ALLOC_PTR, #24 cmp ALLOC_PTR, ALLOC_LIMIT - b.lo .Lcaml_call_gc + b.lo L(caml_call_gc) ret CFI_ENDPROC - .size caml_alloc2, .-caml_alloc2 + END_FUNCTION(caml_alloc2) FUNCTION(caml_alloc3) CFI_STARTPROC sub ALLOC_PTR, ALLOC_PTR, #32 cmp ALLOC_PTR, ALLOC_LIMIT - b.lo .Lcaml_call_gc + b.lo L(caml_call_gc) ret CFI_ENDPROC - .size caml_alloc3, .-caml_alloc3 + END_FUNCTION(caml_alloc3) FUNCTION(caml_allocN) CFI_STARTPROC - sub ALLOC_PTR, ALLOC_PTR, ARG + sub ALLOC_PTR, ALLOC_PTR, ADDITIONAL_ARG cmp ALLOC_PTR, ALLOC_LIMIT - b.lo .Lcaml_call_gc + b.lo L(caml_call_gc) ret CFI_ENDPROC - .size caml_allocN, .-caml_allocN + END_FUNCTION(caml_allocN) /* Call a C function from OCaml */ -/* Function to call is in ARG */ +/* Function to call is in ADDITIONAL_ARG */ FUNCTION(caml_c_call) CFI_STARTPROC @@ -237,27 +293,28 @@ FUNCTION(caml_c_call) str ALLOC_PTR, Caml_state(young_ptr) str TRAP_PTR, Caml_state(exception_pointer) /* Call the function */ - blr ARG + blr ADDITIONAL_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 + END_FUNCTION(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) + mov TMP, C_ARG_1 + ADDRGLOBAL(TMP2, caml_program) /* Code shared with caml_callback* */ -/* Address of OCaml code to call is in ARG */ +/* Address of domain state is in TMP */ +/* Address of OCaml code to call is in TMP2 */ /* Arguments to the OCaml code are in x0...x7 */ -.Ljump_to_caml: +L(jump_to_caml): /* Set up stack frame and save callee-save registers */ CFI_OFFSET(29, -160) CFI_OFFSET(30, -152) @@ -274,7 +331,7 @@ FUNCTION(caml_start_program) stp d12, d13, [sp, 128] stp d14, d15, [sp, 144] /* Load domain state pointer from argument */ - mov DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR + mov DOMAIN_STATE_PTR, TMP /* Setup a callback link on the stack */ ldr x8, Caml_state(bottom_of_stack) ldr x9, Caml_state(last_return_address) @@ -284,7 +341,7 @@ FUNCTION(caml_start_program) 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 + adr x9, L(trap_handler) stp x8, x9, [sp, -16]! CFI_ADJUST(16) add TRAP_PTR, sp, #0 @@ -292,14 +349,14 @@ FUNCTION(caml_start_program) ldr ALLOC_PTR, Caml_state(young_ptr) ldr ALLOC_LIMIT, Caml_state(young_limit) /* Call the OCaml code */ - blr ARG -.Lcaml_retaddr: + blr TMP2 +L(caml_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: +L(return_result): ldr x10, [sp, 16] ldp x8, x9, [sp], 32 CFI_ADJUST(-32) @@ -323,24 +380,20 @@ FUNCTION(caml_start_program) /* Return to C caller */ ret CFI_ENDPROC - .type .Lcaml_retaddr, %function - .size .Lcaml_retaddr, .-.Lcaml_retaddr - .size caml_start_program, .-caml_start_program + END_FUNCTION(caml_start_program) /* The trap handler */ .align 2 -.Ltrap_handler: +L(trap_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 + b L(return_result) CFI_ENDPROC - .type .Ltrap_handler, %function - .size .Ltrap_handler, .-.Ltrap_handler /* Raise an exception from OCaml */ @@ -362,12 +415,12 @@ FUNCTION(caml_raise_exn) 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 + bl G(caml_stash_backtrace) /* Restore exception bucket and raise */ mov x0, x19 b 1b CFI_ENDPROC - .size caml_raise_exn, .-caml_raise_exn + END_FUNCTION(caml_raise_exn) /* Raise an exception from C */ @@ -397,12 +450,12 @@ FUNCTION(caml_raise_exception) 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 + bl G(caml_stash_backtrace) /* Restore exception bucket and raise */ mov x0, x19 b 1b CFI_ENDPROC - .size caml_raise_exception, .-caml_raise_exception + END_FUNCTION(caml_raise_exception) /* Callback from C to OCaml */ @@ -410,74 +463,64 @@ FUNCTION(caml_callback_asm) CFI_STARTPROC /* Initial shuffling of arguments */ /* (x0 = Caml_state, x1 = closure, [x2] = first arg) */ - mov ARG_DOMAIN_STATE_PTR, x0 + mov TMP, x0 ldr x0, [x2] /* x0 = first arg */ /* x1 = closure environment */ - ldr ARG, [x1] /* code pointer */ - b .Ljump_to_caml + ldr TMP2, [x1] /* code pointer */ + b L(jump_to_caml) CFI_ENDPROC - .type caml_callback_asm, %function - .size caml_callback_asm, .-caml_callback_asm + END_FUNCTION(caml_callback_asm) - TEXT_SECTION(caml_callback2_asm) - .align 2 - .globl caml_callback2_asm -caml_callback2_asm: +FUNCTION(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 + mov TMP, x0 + mov TMP2, 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 + mov x2, TMP2 /* x2 = closure environment */ + ADDRGLOBAL(TMP2, caml_apply2) + b L(jump_to_caml) CFI_ENDPROC - .type caml_callback2_asm, %function - .size caml_callback2_asm, .-caml_callback2_asm + END_FUNCTION(caml_callback2_asm) - TEXT_SECTION(caml_callback3_asm) - .align 2 - .globl caml_callback3_asm -caml_callback3_asm: +FUNCTION(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 TMP, 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 + ADDRGLOBAL(TMP2, caml_apply3) + b L(jump_to_caml) CFI_ENDPROC - .size caml_callback3_asm, .-caml_callback3_asm + END_FUNCTION(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) + /* Load address of [caml_array_bound_error] in ADDITIONAL_ARG */ + ADDRGLOBAL(ADDITIONAL_ARG, caml_array_bound_error) /* Call that function */ - b caml_c_call + b G(caml_c_call) CFI_ENDPROC - .size caml_ml_array_bound_error, .-caml_ml_array_bound_error + END_FUNCTION(caml_ml_array_bound_error) - .globl caml_system__code_end -caml_system__code_end: + .globl G(caml_system__code_end) +G(caml_system__code_end): /* GC roots for callback */ - .data - .align 3 - .globl caml_system__frametable -caml_system__frametable: +OBJECT(caml_system__frametable) .quad 1 /* one descriptor */ - .quad .Lcaml_retaddr /* return address into callback */ + .quad L(caml_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 + END_OBJECT(caml_system__frametable) +#if !defined(SYS_macosx) /* Mark stack as non-executable */ .section .note.GNU-stack,"",%progbits +#endif diff --git a/runtime/backtrace_byt.c b/runtime/backtrace_byt.c index 2641daedd..16777e4a3 100644 --- a/runtime/backtrace_byt.c +++ b/runtime/backtrace_byt.c @@ -386,6 +386,7 @@ static void read_main_debug_info(struct debug_info *di) if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) { chan = caml_open_descriptor_in(fd); + Lock(chan); num_events = caml_getword(chan); events = caml_alloc(num_events, 0); @@ -401,6 +402,7 @@ static void read_main_debug_info(struct debug_info *di) /* Record event list */ Store_field(events, i, evl); } + Unlock(chan); caml_close_channel(chan); diff --git a/runtime/caml/alloc.h b/runtime/caml/alloc.h index af6e97980..3ca3c03ce 100644 --- a/runtime/caml/alloc.h +++ b/runtime/caml/alloc.h @@ -51,10 +51,8 @@ CAMLextern value caml_alloc_sprintf(const char * format, ...) ; CAMLextern value caml_alloc_some(value); -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, diff --git a/runtime/caml/backtrace.h b/runtime/caml/backtrace.h index 5cf24b858..b44b952d1 100644 --- a/runtime/caml/backtrace.h +++ b/runtime/caml/backtrace.h @@ -96,7 +96,7 @@ * It might be called before GC initialization, so it shouldn't do OCaml * allocation. */ -CAMLprim value caml_record_backtrace(value vflag); +CAMLextern value caml_record_backtrace(value vflag); #ifndef NATIVE_CODE @@ -122,7 +122,7 @@ extern void caml_stash_backtrace(value exn, value * sp, int reraise); CAMLextern void caml_print_exception_backtrace(void); void caml_init_backtrace(void); -CAMLexport void caml_init_debug_info(void); +CAMLextern void caml_init_debug_info(void); #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/compatibility.h b/runtime/caml/compatibility.h index 1ec4df3fe..1c0150e6d 100644 --- a/runtime/caml/compatibility.h +++ b/runtime/caml/compatibility.h @@ -264,7 +264,6 @@ #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 diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h index 2713867bd..420121f43 100644 --- a/runtime/caml/custom.h +++ b/runtime/caml/custom.h @@ -75,6 +75,11 @@ extern struct custom_operations * caml_final_custom_operations(void (*fn)(value)); extern void caml_init_custom_operations(void); + +extern struct custom_operations caml_nativeint_ops; +extern struct custom_operations caml_int32_ops; +extern struct custom_operations caml_int64_ops; +extern struct custom_operations caml_ba_ops; #endif /* CAML_INTERNALS */ #ifdef __cplusplus diff --git a/runtime/caml/io.h b/runtime/caml/io.h index 2d961f956..7b5fe2fd9 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -56,6 +56,7 @@ enum { 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 */ + CHANNEL_TEXT_MODE = 8, /* "Text mode" for Windows and Cygwin */ }; /* For an output channel: @@ -64,8 +65,19 @@ enum { [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. */ +/* Creating and closing channels from C */ + +CAMLextern struct channel * caml_open_descriptor_in (int); +CAMLextern struct channel * caml_open_descriptor_out (int); +CAMLextern void caml_close_channel (struct channel *); +CAMLextern file_offset caml_channel_size (struct channel *); +CAMLextern void caml_seek_in (struct channel *, file_offset); +CAMLextern void caml_seek_out (struct channel *, file_offset); +CAMLextern file_offset caml_pos_in (struct channel *); +CAMLextern file_offset caml_pos_out (struct channel *); + +/* I/O on channels from C. The channel must be locked (see below) before + calling any of the functions and macros below */ #define caml_putch(channel, ch) do{ \ if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \ @@ -77,11 +89,8 @@ enum { ? 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_channel_binary_mode (struct channel *); CAMLextern int caml_flush_partial (struct channel *); CAMLextern void caml_flush (struct channel *); @@ -119,6 +128,10 @@ CAMLextern struct channel * caml_all_opened_channels; #define Val_file_offset(fofs) caml_copy_int64(fofs) #define File_offset_val(v) ((file_offset) Int64_val(v)) +/* Primitives required by the Unix library */ +CAMLextern value caml_ml_open_descriptor_in(value fd); +CAMLextern value caml_ml_open_descriptor_out(value fd); + #endif /* CAML_INTERNALS */ #endif /* CAML_IO_H */ diff --git a/runtime/caml/memory.h b/runtime/caml/memory.h index 2669cfdfc..eaa2e3c28 100644 --- a/runtime/caml/memory.h +++ b/runtime/caml/memory.h @@ -57,11 +57,13 @@ 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 color_t caml_allocation_color (void *hp); +#ifdef CAML_INTERNALS 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); +#endif /* CAML_INTERNALS */ CAMLextern int caml_huge_fallback_count; diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h index 20baa8d5e..eefd38507 100644 --- a/runtime/caml/minor_gc.h +++ b/runtime/caml/minor_gc.h @@ -63,11 +63,13 @@ 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. */ +CAMLextern void caml_minor_collection (void); + +#ifdef CAML_INTERNALS 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_gc_dispatch (void); +extern void caml_garbage_collection (void); /* runtime/signals_nat.c */ extern void caml_oldify_one (value, value *); extern void caml_oldify_mopup (void); @@ -131,4 +133,6 @@ Caml_inline void add_to_custom_table (struct caml_custom_table *tbl, value v, elt->max = max; } +#endif /* CAML_INTERNALS */ + #endif /* CAML_MINOR_GC_H */ diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 4d9ac010a..1eab3722e 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -259,6 +259,7 @@ extern double caml_log1p(double); #define unlink_os _wunlink #define rename_os caml_win32_rename #define chdir_os _wchdir +#define mkdir_os(path, perm) _wmkdir(path) #define getcwd_os _wgetcwd #define system_os _wsystem #define rmdir_os _wrmdir @@ -294,6 +295,7 @@ extern double caml_log1p(double); #define unlink_os unlink #define rename_os rename #define chdir_os chdir +#define mkdir_os mkdir #define getcwd_os getcwd #define system_os system #define rmdir_os rmdir diff --git a/runtime/caml/osdeps.h b/runtime/caml/osdeps.h index d41779d3f..28451d90a 100644 --- a/runtime/caml/osdeps.h +++ b/runtime/caml/osdeps.h @@ -30,12 +30,16 @@ extern unsigned short caml_win32_revision; #include "misc.h" #include "memory.h" +#define Io_interrupted (-1) + /* 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]. */ + In case of error, raises [Sys_error] or [Sys_blocked_io]. + If interrupted by a signal and no bytes where read, returns + Io_interrupted without raising. */ 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]. @@ -43,7 +47,9 @@ extern int caml_read_fd(int fd, int flags, void * buf, int n); (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]. */ + In case of error, raises [Sys_error] or [Sys_blocked_io]. + If interrupted by a signal and no bytes were written, returns + Io_interrupted without raising. */ 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 @@ -153,6 +159,8 @@ extern value caml_copy_string_of_utf16(const wchar_t *s); extern int caml_win32_isatty(int fd); +CAMLextern void caml_expand_command_line (int *, wchar_t ***); + #endif /* _WIN32 */ #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/printexc.h b/runtime/caml/printexc.h index 92c5af536..8ae788b13 100644 --- a/runtime/caml/printexc.h +++ b/runtime/caml/printexc.h @@ -26,7 +26,9 @@ extern "C" { CAMLextern char * caml_format_exception (value); +#ifdef CAML_INTERNALS CAMLnoreturn_start void caml_fatal_uncaught_exception (value) CAMLnoreturn_end; +#endif /* CAML_INTERNALS */ #ifdef __cplusplus } diff --git a/runtime/caml/roots.h b/runtime/caml/roots.h index 755aa8a7e..8ac9d8d26 100644 --- a/runtime/caml/roots.h +++ b/runtime/caml/roots.h @@ -29,12 +29,15 @@ 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 *); +CAMLextern void caml_do_local_roots_byt (scanning_action, value *, value *, + struct caml__roots_block *); +#define caml_do_local_roots caml_do_local_roots_byt #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); +CAMLextern void caml_do_local_roots_nat ( + scanning_action f, char * c_bottom_of_stack, + uintnat last_retaddr, value * v_gc_regs, + struct caml__roots_block * gc_local_roots); +#define caml_do_local_roots caml_do_local_roots_nat #endif CAMLextern void (*caml_scan_roots_hook) (scanning_action); diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in index 6b1be0323..3aa4ad938 100644 --- a/runtime/caml/s.h.in +++ b/runtime/caml/s.h.in @@ -106,6 +106,10 @@ /* Define HAS_GETCWD if the library provides the getcwd() function. */ +#undef HAS_SYSTEM + +/* Define HAS_SYSTEM if the library provides the system() function. */ + #undef HAS_UTIME #undef HAS_UTIMES diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h index 7ec1ad3ba..953acc851 100644 --- a/runtime/caml/signals.h +++ b/runtime/caml/signals.h @@ -31,6 +31,7 @@ extern "C" { #endif CAMLextern void caml_enter_blocking_section (void); +CAMLextern void caml_enter_blocking_section_no_pending (void); CAMLextern void caml_leave_blocking_section (void); CAMLextern void caml_process_pending_actions (void); @@ -39,6 +40,9 @@ CAMLextern void caml_process_pending_actions (void); Memprof callbacks. Assumes that the runtime lock is held. Can raise exceptions asynchronously into OCaml code. */ +CAMLextern int caml_check_pending_actions (void); +/* Returns 1 if there are pending actions, 0 otherwise. */ + CAMLextern value caml_process_pending_actions_exn (void); /* Same as [caml_process_pending_actions], but returns the exception if any (otherwise returns [Val_unit]). */ @@ -86,7 +90,6 @@ 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 diff --git a/runtime/caml/startup.h b/runtime/caml/startup.h index abbcd596d..60a3807a0 100644 --- a/runtime/caml/startup.h +++ b/runtime/caml/startup.h @@ -21,8 +21,6 @@ #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, diff --git a/runtime/caml/sys.h b/runtime/caml/sys.h index 39e24c57c..8f5683e01 100644 --- a/runtime/caml/sys.h +++ b/runtime/caml/sys.h @@ -41,7 +41,6 @@ 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; diff --git a/runtime/caml/weak.h b/runtime/caml/weak.h index df35fac96..8192496f0 100644 --- a/runtime/caml/weak.h +++ b/runtime/caml/weak.h @@ -191,6 +191,7 @@ Caml_inline void caml_ephe_clean_partial (value v, } } } + if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child); if (Is_white_val (child) && !Is_young (child)){ release_data = 1; Field (v, i) = caml_ephe_none; @@ -200,15 +201,16 @@ Caml_inline void caml_ephe_clean_partial (value v, 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))); - } + if (release_data) Field (v, 1) = caml_ephe_none; +#ifdef DEBUG + else if (offset_start == 2 && offset_end == Wosize_hd (Hd_val(v)) && + Is_block (child) && Is_in_heap (child)) { + if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child); + /* If we scanned all the keys and the data field remains filled, + then the mark phase must have marked it */ + CAMLassert( !Is_white_val (child) ); + } +#endif } } diff --git a/runtime/custom.c b/runtime/custom.c index 8568b5875..62baf2e70 100644 --- a/runtime/custom.c +++ b/runtime/custom.c @@ -155,11 +155,6 @@ struct custom_operations * caml_final_custom_operations(final_fun fn) 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); diff --git a/runtime/debugger.c b/runtime/debugger.c index 050389e21..e2a449045 100644 --- a/runtime/debugger.c +++ b/runtime/debugger.c @@ -141,6 +141,12 @@ static void open_connection(void) #endif dbg_in = caml_open_descriptor_in(dbg_socket); dbg_out = caml_open_descriptor_out(dbg_socket); + /* The code in this file does not bracket channel I/O operations with + Lock and Unlock, so fail if those are not no-ops. */ + if (caml_channel_mutex_lock != NULL || + caml_channel_mutex_unlock != NULL || + caml_channel_mutex_unlock_exn != NULL) + caml_fatal_error("debugger does not support channel locks"); if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */ #ifdef _WIN32 caml_putword(dbg_out, _getpid()); diff --git a/runtime/fail_byt.c b/runtime/fail_byt.c index b2e8d8b78..389a23047 100644 --- a/runtime/fail_byt.c +++ b/runtime/fail_byt.c @@ -34,6 +34,8 @@ CAMLexport void caml_raise(value v) { Unlock_exn(); + CAMLassert(!Is_exception_result(v)); + v = caml_process_pending_actions_with_root(v); Caml_state->exn_bucket = v; if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v); siglongjmp(Caml_state->external_raise->buf, 1); diff --git a/runtime/fail_nat.c b/runtime/fail_nat.c index 380578ac4..cd16966f6 100644 --- a/runtime/fail_nat.c +++ b/runtime/fail_nat.c @@ -62,6 +62,10 @@ CAMLno_asan void caml_raise(value v) { Unlock_exn(); + + CAMLassert(!Is_exception_result(v)); + v = caml_process_pending_actions_with_root(v); + if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v); while (Caml_state->local_roots != NULL && diff --git a/runtime/io.c b/runtime/io.c index 1db7ef0f7..b5dbb606d 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -69,13 +69,35 @@ CAMLexport struct channel * caml_all_opened_channels = NULL; /* Functions shared between input and output */ +static void check_pending(struct channel *channel) +{ + if (caml_check_pending_actions()) { + /* Temporarily unlock the channel, to ensure locks are not held + while any signal handlers (or finalisers, etc) are running */ + Unlock(channel); + caml_process_pending_actions(); + Lock(channel); + } +} + +Caml_inline int descriptor_is_in_binary_mode(int fd) +{ +#if defined(_WIN32) || defined(__CYGWIN__) + int oldmode = setmode(fd, O_TEXT); + if (oldmode != -1 && oldmode != O_TEXT) setmode(fd, oldmode); + return oldmode == O_BINARY; +#else + return 1; +#endif +} + 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(); + caml_enter_blocking_section_no_pending(); channel->offset = lseek(fd, 0, SEEK_CUR); caml_leave_blocking_section(); channel->curr = channel->max = channel->buff; @@ -84,7 +106,7 @@ CAMLexport struct channel * caml_open_descriptor_in(int fd) channel->revealed = 0; channel->old_revealed = 0; channel->refcount = 0; - channel->flags = 0; + channel->flags = descriptor_is_in_binary_mode(fd) ? 0 : CHANNEL_TEXT_MODE; channel->next = caml_all_opened_channels; channel->prev = NULL; channel->name = NULL; @@ -128,33 +150,32 @@ CAMLexport void caml_close_channel(struct channel *channel) CAMLexport file_offset caml_channel_size(struct channel *channel) { - file_offset offset; - file_offset end; + file_offset here, end; int fd; + check_pending(channel); /* 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); + here = channel->flags & CHANNEL_TEXT_MODE ? -1 : channel->offset; + caml_enter_blocking_section_no_pending(); + if (here == -1) { + here = lseek(fd, 0, SEEK_CUR); + if (here == -1) goto error; } + end = lseek(fd, 0, SEEK_END); + if (end == -1) goto error; + if (lseek(fd, here, SEEK_SET) != here) goto error; caml_leave_blocking_section(); return end; + error: + caml_leave_blocking_section(); + caml_sys_error(NO_ARG); } 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 + return channel->flags & CHANNEL_TEXT_MODE ? 0 : 1; } /* Output */ @@ -167,12 +188,15 @@ CAMLexport int caml_channel_binary_mode(struct channel *channel) CAMLexport int caml_flush_partial(struct channel *channel) { int towrite, written; + again: + check_pending(channel); towrite = channel->curr - channel->buff; CAMLassert (towrite >= 0); if (towrite > 0) { written = caml_write_fd(channel->fd, channel->flags, channel->buff, towrite); + if (written == Io_interrupted) goto again; channel->offset += written; if (written < towrite) memmove(channel->buff, channel->buff + written, towrite - written); @@ -202,7 +226,7 @@ CAMLexport void caml_putword(struct channel *channel, uint32_t w) CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len) { - int n, free, towrite, written; + int n, free; n = len >= INT_MAX ? INT_MAX : (int) len; free = channel->end - channel->curr; @@ -215,13 +239,8 @@ CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len) /* 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; + channel->curr = channel->end; + caml_flush_partial(channel); return free; } } @@ -240,7 +259,7 @@ CAMLexport void caml_really_putblock(struct channel *channel, CAMLexport void caml_seek_out(struct channel *channel, file_offset dest) { caml_flush(channel); - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); if (lseek(channel->fd, dest, SEEK_SET) != dest) { caml_leave_blocking_section(); caml_sys_error(NO_ARG); @@ -256,19 +275,24 @@ CAMLexport file_offset caml_pos_out(struct channel *channel) /* Input */ -/* caml_do_read is exported for Cash */ -CAMLexport int caml_do_read(int fd, char *p, unsigned int n) +int caml_do_read(int fd, char *p, unsigned int n) { - return caml_read_fd(fd, 0, p, n); + int r; + do { + r = caml_read_fd(fd, 0, p, n); + } while (r == Io_interrupted); + return r; } CAMLexport unsigned char caml_refill(struct channel *channel) { int n; - + again: + check_pending(channel); n = caml_read_fd(channel->fd, channel->flags, channel->buff, channel->end - channel->buff); - if (n == 0) caml_raise_end_of_file(); + if (n == Io_interrupted) goto again; + else if (n == 0) caml_raise_end_of_file(); channel->offset += n; channel->max = channel->buff + n; channel->curr = channel->buff + 1; @@ -292,7 +316,8 @@ CAMLexport uint32_t caml_getword(struct channel *channel) CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len) { int n, avail, nread; - + again: + check_pending(channel); n = len >= INT_MAX ? INT_MAX : (int) len; avail = channel->max - channel->curr; if (n <= avail) { @@ -306,6 +331,7 @@ CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len) } else { nread = caml_read_fd(channel->fd, channel->flags, channel->buff, channel->end - channel->buff); + if (nread == Io_interrupted) goto again; channel->offset += nread; channel->max = channel->buff + nread; if (n > nread) n = nread; @@ -331,11 +357,12 @@ CAMLexport intnat caml_really_getblock(struct channel *chan, char *p, intnat n) CAMLexport void caml_seek_in(struct channel *channel, file_offset dest) { - if (dest >= channel->offset - (channel->max - channel->buff) && - dest <= channel->offset) { + if (dest >= channel->offset - (channel->max - channel->buff) + && dest <= channel->offset + && (channel->flags & CHANNEL_TEXT_MODE) == 0) { channel->curr = channel->max - (channel->offset - dest); } else { - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); if (lseek(channel->fd, dest, SEEK_SET) != dest) { caml_leave_blocking_section(); caml_sys_error(NO_ARG); @@ -351,11 +378,12 @@ 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) +intnat caml_input_scan_line(struct channel *channel) { char * p; int n; - + again: + check_pending(channel); p = channel->curr; do { if (p >= channel->max) { @@ -378,7 +406,8 @@ CAMLexport intnat caml_input_scan_line(struct channel *channel) /* Fill the buffer as much as possible */ n = caml_read_fd(channel->fd, channel->flags, channel->max, channel->end - channel->max); - if (n == 0) { + if (n == Io_interrupted) goto again; + else 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. */ @@ -396,8 +425,7 @@ CAMLexport intnat caml_input_scan_line(struct channel *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) +void caml_finalize_channel(value vchan) { struct channel * chan = Channel(vchan); if ((chan->flags & CHANNEL_FLAG_MANAGED_BY_GC) == 0) return; @@ -545,7 +573,7 @@ CAMLprim value caml_ml_close_channel(value vchannel) channel->curr = channel->max = channel->end; if (do_syscall) { - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); result = close(fd); caml_leave_blocking_section(); } @@ -563,16 +591,28 @@ CAMLprim value caml_ml_close_channel(value vchannel) #define EOVERFLOW ERANGE #endif +static file_offset ml_channel_size(value vchannel) +{ + CAMLparam1 (vchannel); + struct channel * channel = Channel(vchannel); + file_offset size; + + Lock(channel); + size = caml_channel_size(Channel(vchannel)); + Unlock(channel); + CAMLreturnT(file_offset, size); +} + CAMLprim value caml_ml_channel_size(value vchannel) { - file_offset size = caml_channel_size(Channel(vchannel)); + file_offset size = ml_channel_size(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))); + return Val_file_offset(ml_channel_size(vchannel)); } CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode) @@ -590,6 +630,10 @@ CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode) #endif if (setmode(channel->fd, Bool_val(mode) ? O_BINARY : O_TEXT) == -1) caml_sys_error(NO_ARG); + if (Bool_val(mode)) + channel->flags &= ~CHANNEL_TEXT_MODE; + else + channel->flags |= CHANNEL_TEXT_MODE; #endif return Val_unit; } @@ -731,6 +775,8 @@ CAMLprim value caml_ml_input(value vchannel, value buff, value vstart, int n, avail, nread; Lock(channel); + again: + check_pending(channel); /* We cannot call caml_getblock here because buff may move during caml_read_fd */ start = Long_val(vstart); @@ -747,6 +793,7 @@ CAMLprim value caml_ml_input(value vchannel, value buff, value vstart, } else { nread = caml_read_fd(channel->fd, channel->flags, channel->buff, channel->end - channel->buff); + if (nread == Io_interrupted) goto again; channel->offset += nread; channel->max = channel->buff + nread; if (n > nread) n = nread; diff --git a/runtime/main.c b/runtime/main.c index 5e5839fff..ec97abc3d 100644 --- a/runtime/main.c +++ b/runtime/main.c @@ -22,15 +22,12 @@ #include "caml/mlvalues.h" #include "caml/sys.h" #include "caml/osdeps.h" +#include "caml/callback.h" #ifdef _WIN32 #include #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) diff --git a/runtime/major_gc.c b/runtime/major_gc.c index d08d8f936..92e092d58 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -57,7 +57,7 @@ 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. */ +extern value caml_fl_merge; /* Defined in freelist.c. */ static char *markhp, *chunk, *limit; static double p_backlog = 0.0; /* backlog for the gc speedup parameter */ @@ -586,7 +586,7 @@ static void sweep_slice (intnat work) break; case Caml_blue: /* Only the blocks of the free-list are blue. See [freelist.c]. */ - caml_fl_merge = Bp_hp (hp); + caml_fl_merge = (value) Bp_hp (hp); break; default: /* gray or black */ CAMLassert (Color_hd (hd) == Caml_black); diff --git a/runtime/memory.c b/runtime/memory.c index a58c68976..20d09cf78 100644 --- a/runtime/memory.c +++ b/runtime/memory.c @@ -455,7 +455,7 @@ void caml_shrink_heap (char *chunk) caml_free_for_heap (chunk); } -color_t caml_allocation_color (void *hp) +CAMLexport 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)){ diff --git a/runtime/memprof.c b/runtime/memprof.c index 48c17689b..699194cf1 100644 --- a/runtime/memprof.c +++ b/runtime/memprof.c @@ -183,7 +183,7 @@ static void rand_batch(void) { for(i = 0; i < RAND_BLOCK_SIZE; i++) { double f = B[i]; CAMLassert (f >= 1); - if(f > Max_long) rand_geom_buff[i] = Max_long; + if(f > (double)Max_long) rand_geom_buff[i] = Max_long; else rand_geom_buff[i] = (uintnat)f; } diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index b8661bc7e..42acd6356 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -284,9 +284,9 @@ Caml_inline int ephe_check_alive_data(struct caml_ephe_ref_elt *re){ 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; + && Is_block (child) && Is_young (child)) { + if(Tag_val(child) == Infix_tag) child -= Infix_offset_val(child); + if(Hd_val (child) != 0) return 0; /* Value not copied to major heap */ } } return 1; @@ -301,7 +301,10 @@ void caml_oldify_mopup (void) value v, new_v, f; mlsize_t i; struct caml_ephe_ref_elt *re; - int redo = 0; + int redo; + + again: + redo = 0; while (oldify_todo_list != 0){ v = oldify_todo_list; /* Get the head. */ @@ -329,10 +332,12 @@ void caml_oldify_mopup (void) 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); + value *data = &Field(re->ephe,1), v = *data; + if (v != caml_ephe_none && Is_block (v) && Is_young (v)){ + mlsize_t offs = Tag_val(v) == Infix_tag ? Infix_offset_val(v) : 0; + v -= offs; + if (Hd_val (v) == 0){ /* Value copied to major heap */ + *data = Field (v, 0) + offs; } else { if (ephe_check_alive_data(re)){ caml_oldify_one(*data,data); @@ -343,7 +348,7 @@ void caml_oldify_mopup (void) } } - if (redo) caml_oldify_mopup (); + if (redo) goto again; } /* Make sure the minor heap is empty by performing a minor collection @@ -379,10 +384,12 @@ void caml_empty_minor_heap (void) 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); + value *key = &Field(re->ephe,re->offset), v = *key; + if (v != caml_ephe_none && Is_block (v) && Is_young (v)){ + mlsize_t offs = Tag_val (v) == Infix_tag ? Infix_offset_val (v) : 0; + v -= offs; + if (Hd_val (v) == 0){ /* Value copied to major heap */ + *key = Field (v, 0) + offs; }else{ /* Value not copied so it's dead */ CAMLassert(!ephe_check_alive_data(re)); *key = caml_ephe_none; @@ -455,7 +462,7 @@ extern uintnat caml_instr_alloc_jump; 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) +void caml_gc_dispatch (void) { value *trigger = Caml_state->young_trigger; /* save old value of trigger */ diff --git a/runtime/riscv.S b/runtime/riscv.S index 48e690e44..d3a5a794b 100644 --- a/runtime/riscv.S +++ b/runtime/riscv.S @@ -63,9 +63,8 @@ FUNCTION(caml_call_gc) /* 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, + /* (1 reg for RA, 1 reg for FP, 22 allocatable int regs, 20 caller-save float regs) * 8 */ - /* + 1 for alignment */ addi sp, sp, -0x160 STORE ra, 0x8(sp) STORE s0, 0x0(sp) @@ -92,26 +91,26 @@ FUNCTION(caml_call_gc) STORE t4, 0xa0(sp) STORE t5, 0xa8(sp) STORE t6, 0xb0(sp) + STORE t0, 0xb8(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 ft0, 0xc0(sp) + fsd ft1, 0xc8(sp) + fsd ft2, 0xd0(sp) + fsd ft3, 0xd8(sp) + fsd ft4, 0xe0(sp) + fsd ft5, 0xe8(sp) + fsd ft6, 0xf0(sp) + fsd ft7, 0xf8(sp) + fsd fa0, 0x100(sp) + fsd fa1, 0x108(sp) + fsd fa2, 0x110(sp) + fsd fa3, 0x118(sp) + fsd fa4, 0x120(sp) + fsd fa5, 0x128(sp) + fsd fa6, 0x130(sp) + fsd fa7, 0x138(sp) + fsd ft8, 0x140(sp) fsd ft9, 0x148(sp) fsd ft10, 0x150(sp) fsd ft11, 0x158(sp) @@ -146,24 +145,24 @@ FUNCTION(caml_call_gc) 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) + LOAD t0, 0xb8(sp) + fld ft0, 0xc0(sp) + fld ft1, 0xc8(sp) + fld ft2, 0xd0(sp) + fld ft3, 0xd8(sp) + fld ft4, 0xe0(sp) + fld ft5, 0xe8(sp) + fld ft6, 0xf0(sp) + fld ft7, 0xf8(sp) + fld fa0, 0x100(sp) + fld fa1, 0x108(sp) + fld fa2, 0x110(sp) + fld fa3, 0x118(sp) + fld fa4, 0x120(sp) + fld fa5, 0x128(sp) + fld fa6, 0x130(sp) + fld fa7, 0x138(sp) + fld ft8, 0x140(sp) fld ft9, 0x148(sp) fld ft10, 0x150(sp) fld ft11, 0x158(sp) diff --git a/runtime/roots_byt.c b/runtime/roots_byt.c index 744495b79..9d65e0806 100644 --- a/runtime/roots_byt.c +++ b/runtime/roots_byt.c @@ -92,8 +92,8 @@ void caml_do_roots (scanning_action f, int do_globals) 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_do_local_roots_byt(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); @@ -113,9 +113,9 @@ void caml_do_roots (scanning_action f, int do_globals) 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) +CAMLexport void caml_do_local_roots_byt (scanning_action f, value *stack_low, + value *stack_high, + struct caml__roots_block *local_roots) { register value * sp; struct caml__roots_block *lr; diff --git a/runtime/roots_nat.c b/runtime/roots_nat.c index ec66e2dbf..aba070619 100644 --- a/runtime/roots_nat.c +++ b/runtime/roots_nat.c @@ -423,9 +423,9 @@ void caml_do_roots (scanning_action f, int do_globals) 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_do_local_roots_nat(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); @@ -445,9 +445,9 @@ void caml_do_roots (scanning_action f, int do_globals) 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) +void caml_do_local_roots_nat(scanning_action f, char * bottom_of_stack, + uintnat last_retaddr, value * gc_regs, + struct caml__roots_block * local_roots) { char * sp; uintnat retaddr; diff --git a/runtime/signals.c b/runtime/signals.c index 57bb3fc71..db76bcbc3 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -62,12 +62,20 @@ CAMLexport int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *) = sigprocmask_wrapper; #endif +static int check_for_pending_signals(void) +{ + int i; + for (i = 0; i < NSIG; i++) { + if (caml_pending_signals[i]) return 1; + } + return 0; +} + /* Execute all pending signals */ value caml_process_pending_signals_exn(void) { int i; - int really_pending; #ifdef POSIX_SIGNALS sigset_t set; #endif @@ -78,13 +86,7 @@ value caml_process_pending_signals_exn(void) /* 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) + if (!check_for_pending_signals()) return Val_unit; #ifdef POSIX_SIGNALS @@ -136,33 +138,18 @@ CAMLno_tsan void caml_record_signal(int signal_number) /* 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) @@ -178,6 +165,11 @@ CAMLexport void caml_enter_blocking_section(void) } } +CAMLexport void caml_enter_blocking_section_no_pending(void) +{ + caml_enter_blocking_section_hook (); +} + CAMLexport void caml_leave_blocking_section(void) { int saved_errno; @@ -197,8 +189,10 @@ CAMLexport void caml_leave_blocking_section(void) 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()); + if (check_for_pending_signals()) { + signals_are_pending = 1; + caml_set_action_pending(); + } errno = saved_errno; } @@ -337,6 +331,12 @@ Caml_inline value process_pending_actions_with_root_exn(value extra_root) return extra_root; } +CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */ +int caml_check_pending_actions() +{ + return caml_something_to_do; +} + value caml_process_pending_actions_with_root(value extra_root) { value res = process_pending_actions_with_root_exn(extra_root); diff --git a/runtime/signals_byt.c b/runtime/signals_byt.c index 040de03c5..35ee610a3 100644 --- a/runtime/signals_byt.c +++ b/runtime/signals_byt.c @@ -46,12 +46,7 @@ static void handle_signal(int signal_number) 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); - } + caml_record_signal(signal_number); errno = saved_errno; } diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c index 9ee2b2647..6b96a1177 100644 --- a/runtime/signals_nat.c +++ b/runtime/signals_nat.c @@ -99,19 +99,14 @@ DECLARE_SIGNAL_HANDLER(handle_signal) 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); + 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 (caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL) - CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit; + if (caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL) + CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit; #endif - } errno = saved_errno; } diff --git a/runtime/signals_osdep.h b/runtime/signals_osdep.h index 6c3023272..5b23bbf93 100644 --- a/runtime/signals_osdep.h +++ b/runtime/signals_osdep.h @@ -47,8 +47,9 @@ #include #include - #if !defined(MAC_OS_X_VERSION_10_5) \ - || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 + #if (!defined(MAC_OS_X_VERSION_10_5) \ + || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5) \ + && !defined(__IPHONE_OS_VERSION_MIN_REQUIRED) #define CONTEXT_REG(r) r #else #define CONTEXT_REG(r) __##r @@ -250,8 +251,9 @@ #include #include - #if !defined(MAC_OS_X_VERSION_10_5) \ - || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 + #if (!defined(MAC_OS_X_VERSION_10_5) \ + || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5) \ + && !defined(__IPHONE_OS_VERSION_MIN_REQUIRED) #define CONTEXT_REG(r) r #else #define CONTEXT_REG(r) __##r diff --git a/runtime/spacetime_byt.c b/runtime/spacetime_byt.c index 2b0bf1dc2..b75fb0980 100644 --- a/runtime/spacetime_byt.c +++ b/runtime/spacetime_byt.c @@ -12,8 +12,12 @@ /* */ /**************************************************************************/ +#define CAML_INTERNALS + #include "caml/fail.h" #include "caml/mlvalues.h" +#include "caml/io.h" +#include "caml/spacetime.h" int caml_ensure_spacetime_dot_o_is_included = 42; @@ -22,7 +26,8 @@ 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) +uintnat caml_spacetime_my_profinfo (spacetime_unwind_info_cache * cached, + uintnat wosize) { return 0; } diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c index 1d04a85ad..9bbcb659b 100644 --- a/runtime/startup_byt.c +++ b/runtime/startup_byt.c @@ -444,7 +444,9 @@ CAMLexport void caml_main(char_os **argv) /* Load the globals */ caml_seek_section(fd, &trail, "DATA"); chan = caml_open_descriptor_in(fd); + Lock(chan); caml_global_data = caml_input_val(chan); + Unlock(chan); caml_close_channel(chan); /* this also closes fd */ caml_stat_free(trail.section); /* Ensure that the globals are in the major heap. */ diff --git a/runtime/sys.c b/runtime/sys.c index 6b67c7a8b..a131bcc17 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -319,6 +319,36 @@ CAMLprim value caml_sys_chdir(value dirname) CAMLreturn(Val_unit); } +CAMLprim value caml_sys_mkdir(value path, value perm) +{ + CAMLparam2(path, perm); + char_os * p; + int ret; + caml_sys_check_path(path); + p = caml_stat_strdup_to_os(String_val(path)); + caml_enter_blocking_section(); + ret = mkdir_os(p, Int_val(perm)); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) caml_sys_error(path); + CAMLreturn(Val_unit); +} + +CAMLprim value caml_sys_rmdir(value path) +{ + CAMLparam1(path); + char_os * p; + int ret; + caml_sys_check_path(path); + 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) caml_sys_error(path); + CAMLreturn(Val_unit); +} + CAMLprim value caml_sys_getcwd(value unit) { char_os buff[4096]; @@ -431,6 +461,7 @@ void caml_sys_init(char_os * exe_name, char_os **argv) #endif #endif +#ifdef HAS_SYSTEM CAMLprim value caml_sys_system_command(value command) { CAMLparam1 (command); @@ -453,6 +484,12 @@ CAMLprim value caml_sys_system_command(value command) retcode = 255; CAMLreturn (Val_int(retcode)); } +#else +CAMLprim value caml_sys_system_command(value command) +{ + caml_invalid_argument("Sys.command not implemented"); +} +#endif double caml_sys_time_include_children_unboxed(value include_children) { diff --git a/runtime/unix.c b/runtime/unix.c index c0ddbaaaf..e381690b0 100644 --- a/runtime/unix.c +++ b/runtime/unix.c @@ -74,12 +74,13 @@ 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); + caml_enter_blocking_section_no_pending(); + retcode = read(fd, buf, n); + caml_leave_blocking_section(); + if (retcode == -1) { + if (errno == EINTR) return Io_interrupted; + else caml_sys_io_error(NO_ARG); + } return retcode; } @@ -92,14 +93,14 @@ int caml_write_fd(int fd, int flags, void * buf, int n) retcode = write(fd, buf, n); } else { #endif - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); 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 == EINTR) return Io_interrupted; 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 diff --git a/runtime/weak.c b/runtime/weak.c index da509637f..ba8ab50ec 100644 --- a/runtime/weak.c +++ b/runtime/weak.c @@ -46,12 +46,18 @@ value caml_ephe_none = (value) &ephe_dummy; 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) ); \ +#ifdef DEBUG +#define CAMLassert_not_dead_value(v) do{ \ + if (caml_gc_phase == Phase_clean \ + && Is_block(v) \ + && Is_in_heap (v)) { \ + if (Tag_val (v) == Infix_tag) v -= Infix_offset_val (v); \ + CAMLassert ( !Is_white_val(v) ); \ + } \ }while(0) +#else +#define CAMLassert_not_dead_value(v) +#endif CAMLexport mlsize_t caml_ephemeron_num_keys(value eph) { @@ -66,10 +72,12 @@ Caml_inline int Is_Dead_during_clean(value x) { CAMLassert (x != caml_ephe_none); CAMLassert (caml_gc_phase == Phase_clean); + if (!Is_block(x)) return 0; + if (Tag_val(x) == Infix_tag) x -= Infix_offset_val(x); #ifdef NO_NAKED_POINTERS - return Is_block (x) && !Is_young (x) && Is_white_val(x); + return Is_white_val(x) && !Is_young (x); #else - return Is_block (x) && Is_in_heap (x) && Is_white_val(x); + return Is_white_val(x) && Is_in_heap (x); #endif } /** The minor heap doesn't have to be marked, outside they should @@ -369,7 +377,7 @@ Caml_inline void copy_value(value src, value dst) CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset, value *key) { - mlsize_t loop = 0; + mlsize_t loop = 0, infix_offs; CAMLparam1(ar); value elt = Val_unit, v; /* Caution: they are NOT local roots. */ CAMLassert_valid_offset(ar, offset); @@ -387,6 +395,8 @@ CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset, *key = v; CAMLreturn(1); } + infix_offs = Tag_val(v) == Infix_tag ? Infix_offset_val(v) : 0; + v -= infix_offs; 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 @@ -396,7 +406,7 @@ CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset, */ CAMLassert_not_dead_value(v); copy_value(v, elt); - *key = elt; + *key = elt + infix_offs; CAMLreturn(1); } @@ -429,7 +439,7 @@ CAMLprim value caml_weak_get_copy (value ar, value n) CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data) { - mlsize_t loop = 0; + mlsize_t loop = 0, infix_offs; CAMLparam1 (ar); value elt = Val_unit, v; /* Caution: they are NOT local roots. */ CAMLassert_valid_ephemeron(ar); @@ -446,12 +456,14 @@ CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data) *data = v; CAMLreturn(1); } + infix_offs = Tag_val(v) == Infix_tag ? Infix_offset_val(v) : 0; + v -= infix_offs; 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; + *data = elt + infix_offs; CAMLreturn(1); } diff --git a/runtime/win32.c b/runtime/win32.c index 948d03c3d..2ab56c462 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -87,7 +87,7 @@ 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(); + caml_enter_blocking_section_no_pending(); retcode = read(fd, buf, n); /* Large reads from console can fail with ENOMEM. Reduce requested size and try again. */ @@ -97,7 +97,7 @@ int caml_read_fd(int fd, int flags, void * buf, int n) caml_leave_blocking_section(); if (retcode == -1) caml_sys_io_error(NO_ARG); } else { - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); retcode = recv((SOCKET) _get_osfhandle(fd), buf, n, 0); caml_leave_blocking_section(); if (retcode == -1) caml_win32_sys_error(WSAGetLastError()); @@ -114,7 +114,7 @@ int caml_write_fd(int fd, int flags, void * buf, int n) retcode = write(fd, buf, n); } else { #endif - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); retcode = write(fd, buf, n); caml_leave_blocking_section(); #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) @@ -122,7 +122,7 @@ int caml_write_fd(int fd, int flags, void * buf, int n) #endif if (retcode == -1) caml_sys_io_error(NO_ARG); } else { - caml_enter_blocking_section(); + caml_enter_blocking_section_no_pending(); retcode = send((SOCKET) _get_osfhandle(fd), buf, n, 0); caml_leave_blocking_section(); if (retcode == -1) caml_win32_sys_error(WSAGetLastError()); diff --git a/stdlib/.depend b/stdlib/.depend index ffaa61937..c6328a81f 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -200,6 +200,11 @@ stdlib__digest.cmx : \ stdlib__bytes.cmx \ stdlib__digest.cmi stdlib__digest.cmi : +stdlib__either.cmo : \ + stdlib__either.cmi +stdlib__either.cmx : \ + stdlib__either.cmi +stdlib__either.cmi : stdlib__ephemeron.cmo : \ stdlib__sys.cmi \ stdlib__seq.cmi \ @@ -387,13 +392,16 @@ stdlib__lexing.cmi : stdlib__list.cmo : \ stdlib__sys.cmi \ stdlib__seq.cmi \ + stdlib__either.cmi \ stdlib__list.cmi stdlib__list.cmx : \ stdlib__sys.cmx \ stdlib__seq.cmx \ + stdlib__either.cmx \ stdlib__list.cmi stdlib__list.cmi : \ - stdlib__seq.cmi + stdlib__seq.cmi \ + stdlib__either.cmi stdlib__listLabels.cmo : \ stdlib__list.cmi \ stdlib__listLabels.cmi @@ -401,7 +409,8 @@ stdlib__listLabels.cmx : \ stdlib__list.cmx \ stdlib__listLabels.cmi stdlib__listLabels.cmi : \ - stdlib__seq.cmi + stdlib__seq.cmi \ + stdlib__either.cmi stdlib__map.cmo : \ stdlib__seq.cmi \ stdlib__map.cmi diff --git a/stdlib/Compflags b/stdlib/Compflags index f91532cad..066e1dc48 100755 --- a/stdlib/Compflags +++ b/stdlib/Compflags @@ -35,5 +35,7 @@ case $1 in *Labels.cmi) echo ' -pp "$AWK -f ./expand_module_aliases.awk"';; *Labels.cm[ox]) echo ' -nolabels -no-alias-deps';; stdlib__float.cm[ox]) echo ' -nolabels -no-alias-deps';; + stdlib__oo.cmi) echo ' -no-principal';; + # preserve structure sharing in Oo.copy (PR#9767) *) echo ' ';; esac diff --git a/stdlib/HACKING.adoc b/stdlib/HACKING.adoc index c29a513a4..fbd40173a 100644 --- a/stdlib/HACKING.adoc +++ b/stdlib/HACKING.adoc @@ -13,7 +13,7 @@ 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 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. diff --git a/stdlib/Makefile b/stdlib/Makefile index 441cedaa0..47c90266a 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -22,7 +22,7 @@ TARGET_BINDIR ?= $(BINDIR) COMPILER=$(ROOTDIR)/ocamlc$(EXE) CAMLC=$(CAMLRUN) $(COMPILER) COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 \ - -g -warn-error A -bin-annot -nostdlib \ + -g -warn-error A -bin-annot -nostdlib -principal \ -safe-string -strict-formats OPTCOMPILER=$(ROOTDIR)/ocamlopt$(EXE) CAMLOPT=$(CAMLRUN) $(OPTCOMPILER) @@ -148,7 +148,8 @@ $(HEADERPROGRAM)%$(O): \ OC_CPPFLAGS += -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"' $(HEADERPROGRAM)%$(O): $(HEADERPROGRAM).c - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $^ + $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \ + $(OUTPUTOBJ)$@ $^ camlheader_ur: camlheader cp camlheader $@ @@ -159,7 +160,7 @@ tmptargetcamlheader%exe: $(TARGETHEADERPROGRAM)%$(O) strip $@ $(TARGETHEADERPROGRAM)%$(O): $(HEADERPROGRAM).c - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) \ + $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \ -DRUNTIME_NAME='"$(HEADER_TARGET_PATH)ocamlrun$(subst .,,$*)"' \ $(OUTPUTOBJ)$@ $^ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index d21befe9d..a49bfa140 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -31,7 +31,7 @@ endef # Modules should be listed in dependency order. STDLIB_MODS=\ camlinternalFormatBasics camlinternalAtomic \ - stdlib pervasives seq option result bool char uchar \ + stdlib pervasives seq option either 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 atomic \ diff --git a/stdlib/bigarray.ml b/stdlib/bigarray.ml index 157881f97..ec3db6dd5 100644 --- a/stdlib/bigarray.ml +++ b/stdlib/bigarray.ml @@ -99,6 +99,27 @@ module Genarray = struct = "caml_ba_get_generic" external set: ('a, 'b, 'c) t -> int array -> 'a -> unit = "caml_ba_set_generic" + + let rec cloop arr idx f col max = + if col = Array.length idx then set arr idx (f idx) + else for j = 0 to pred max.(col) do + idx.(col) <- j; + cloop arr idx f (succ col) max + done + let rec floop arr idx f col max = + if col < 0 then set arr idx (f idx) + else for j = 1 to max.(col) do + idx.(col) <- j; + floop arr idx f (pred col) max + done + let init (type t) kind (layout : t layout) dims f = + let arr = create kind layout dims in + match Array.length dims, layout with + | 0, _ -> arr + | dlen, C_layout -> cloop arr (Array.make dlen 0) f 0 dims; arr + | dlen, Fortran_layout -> floop arr (Array.make dlen 1) f (pred dlen) dims; + arr + 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 = @@ -152,6 +173,7 @@ module Array0 = struct let a = create kind layout in set a v; a + let init = of_value end module Array1 = struct @@ -180,6 +202,15 @@ module Array1 = struct | 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 c_init arr dim f = + for i = 0 to pred dim do unsafe_set arr i (f i) done + let fortran_init arr dim f = + for i = 1 to dim do unsafe_set arr i (f i) done + let init (type t) kind (layout : t layout) dim f = + let arr = create kind layout dim in + match layout with + | C_layout -> c_init arr dim f; arr + | Fortran_layout -> fortran_init arr dim f; arr let of_array (type t) kind (layout: t layout) data = let ba = create kind layout (Array.length data) in let ofs = @@ -221,6 +252,23 @@ module Array2 = struct 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 c_init arr dim1 dim2 f = + for i = 0 to pred dim1 do + for j = 0 to pred dim2 do + unsafe_set arr i j (f i j) + done + done + let fortran_init arr dim1 dim2 f = + for j = 1 to dim2 do + for i = 1 to dim1 do + unsafe_set arr i j (f i j) + done + done + let init (type t) kind (layout : t layout) dim1 dim2 f = + let arr = create kind layout dim1 dim2 in + match layout with + | C_layout -> c_init arr dim1 dim2 f; arr + | Fortran_layout -> fortran_init arr dim1 dim2 f; arr 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 @@ -275,6 +323,27 @@ module Array3 = struct 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 c_init arr dim1 dim2 dim3 f = + for i = 0 to pred dim1 do + for j = 0 to pred dim2 do + for k = 0 to pred dim3 do + unsafe_set arr i j k (f i j k) + done + done + done + let fortran_init arr dim1 dim2 dim3 f = + for k = 1 to dim3 do + for j = 1 to dim2 do + for i = 1 to dim1 do + unsafe_set arr i j k (f i j k) + done + done + done + let init (type t) kind (layout : t layout) dim1 dim2 dim3 f = + let arr = create kind layout dim1 dim2 dim3 in + match layout with + | C_layout -> c_init arr dim1 dim2 dim3 f; arr + | Fortran_layout -> fortran_init arr dim1 dim2 dim3 f; arr 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 diff --git a/stdlib/bigarray.mli b/stdlib/bigarray.mli index 68eacf488..97435606a 100644 --- a/stdlib/bigarray.mli +++ b/stdlib/bigarray.mli @@ -298,6 +298,34 @@ module Genarray : is not in the range 0 to 16 inclusive, or if one of the dimensions is negative. *) + val init: ('a, 'b) kind -> 'c layout -> int array -> (int array -> 'a) -> + ('a, 'b, 'c) t + (** [Genarray.init kind layout dimensions f] returns a new Bigarray [b] + 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. + + Each element [Genarray.get b i] is initialized to the result of [f i]. + In other words, [Genarray.init kind layout dimensions f] tabulates + the results of [f] applied to the indices of a new Bigarray whose + layout is described by [kind], [layout] and [dimensions]. The index + array [i] may be shared and mutated between calls to f. + + For instance, [Genarray.init int c_layout [|2; 1; 3|] + (Array.fold_left (+) 0)] returns a fresh Bigarray of integers, in C + layout, having three dimensions (2, 1, 3, respectively), with the + element values 0, 1, 2, 1, 2, 3. + + [Genarray.init] 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. + + @since 4.12.0 *) + external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims" (** Return the number of dimensions of the given Bigarray. *) @@ -486,6 +514,12 @@ module Array0 : sig [kind] and [layout] determine the array element kind and the array layout as described for {!Genarray.create}. *) + val init: ('a, 'b) kind -> 'c layout -> 'a -> ('a, 'b, 'c) t + (** [Array0.init kind layout v] behaves like [Array0.create kind layout] + except that the element is additionally initialized to the value [v]. + + @since 4.12.0 *) + external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" (** Return the kind of the given Bigarray. *) @@ -545,6 +579,22 @@ module Array1 : sig determine the array element kind and the array layout as described for {!Genarray.create}. *) + val init: ('a, 'b) kind -> 'c layout -> int -> (int -> 'a) -> + ('a, 'b, 'c) t + (** [Array1.init kind layout dim f] returns a new Bigarray [b] + of one dimension, whose size is [dim]. [kind] and [layout] + determine the array element kind and the array layout + as described for {!Genarray.create}. + + Each element [Array1.get b i] of the array is initialized to the + result of [f i]. + + In other words, [Array1.init kind layout dimensions f] tabulates + the results of [f] applied to the indices of a new Bigarray whose + layout is described by [kind], [layout] and [dim]. + + @since 4.12.0 *) + external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1" (** Return the size (dimension) of the given one-dimensional Bigarray. *) @@ -638,11 +688,28 @@ module Array2 : 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 + two dimensions, 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}. *) + val init: ('a, 'b) kind -> 'c layout -> int -> int -> + (int -> int -> 'a) -> ('a, 'b, 'c) t + (** [Array2.init kind layout dim1 dim2 f] returns a new Bigarray [b] + of two dimensions, whose size is [dim2] 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}. + + Each element [Array2.get b i j] of the array is initialized to + the result of [f i j]. + + In other words, [Array2.init kind layout dim1 dim2 f] tabulates + the results of [f] applied to the indices of a new Bigarray whose + layout is described by [kind], [layout], [dim1] and [dim2]. + + @since 4.12.0 *) + external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1" (** Return the first dimension of the given two-dimensional Bigarray. *) @@ -754,11 +821,28 @@ module Array3 : 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, + three dimensions, 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}. *) + val init: ('a, 'b) kind -> 'c layout -> int -> int -> int -> + (int -> int -> int -> 'a) -> ('a, 'b, 'c) t + (** [Array3.init kind layout dim1 dim2 dim3 f] returns a new Bigarray [b] + of three dimensions, 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}. + + Each element [Array3.get b i j k] of the array is initialized to + the result of [f i j k]. + + In other words, [Array3.init kind layout dim1 dim2 dim3 f] tabulates + the results of [f] applied to the indices of a new Bigarray whose + layout is described by [kind], [layout], [dim1], [dim2] and [dim3]. + + @since 4.12.0 *) + external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1" (** Return the first dimension of the given three-dimensional Bigarray. *) diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml index 5c2a2b3bf..239d027ca 100644 --- a/stdlib/camlinternalFormat.ml +++ b/stdlib/camlinternalFormat.ml @@ -2305,7 +2305,7 @@ let fmt_ebb_of_string ?legacy_behavior str = and get_prec () = prec_used := true; prec and get_padprec () = pad_used := true; padprec in - let get_int_pad () = + let get_int_pad () : (x,y) padding = (* %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). @@ -2330,7 +2330,7 @@ let fmt_ebb_of_string ?legacy_behavior str = | Arg_padding _ as pad, _ -> pad in (* Check that padty <> Zeros. *) - let check_no_0 symb (type a) (type b) (pad : (a, b) padding) = + let check_no_0 symb (type a b) (pad : (a, b) padding) : (a,b) padding = match pad with | No_padding -> pad | Lit_padding ((Left | Right), _) -> pad diff --git a/stdlib/either.ml b/stdlib/either.ml new file mode 100644 index 000000000..9ea2f8935 --- /dev/null +++ b/stdlib/either.ml @@ -0,0 +1,66 @@ +(**************************************************************************) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +type ('a, 'b) t = Left of 'a | Right of 'b + +let left v = Left v +let right v = Right v + +let is_left = function +| Left _ -> true +| Right _ -> false + +let is_right = function +| Left _ -> false +| Right _ -> true + +let find_left = function +| Left v -> Some v +| Right _ -> None + +let find_right = function +| Left _ -> None +| Right v -> Some v + +let map_left f = function +| Left v -> Left (f v) +| Right _ as e -> e + +let map_right f = function +| Left _ as e -> e +| Right v -> Right (f v) + +let map ~left ~right = function +| Left v -> Left (left v) +| Right v -> Right (right v) + +let fold ~left ~right = function +| Left v -> left v +| Right v -> right v + +let iter = fold + +let for_all = fold + +let equal ~left ~right e1 e2 = match e1, e2 with +| Left v1, Left v2 -> left v1 v2 +| Right v1, Right v2 -> right v1 v2 +| Left _, Right _ | Right _, Left _ -> false + +let compare ~left ~right e1 e2 = match e1, e2 with +| Left v1, Left v2 -> left v1 v2 +| Right v1, Right v2 -> right v1 v2 +| Left _, Right _ -> (-1) +| Right _, Left _ -> 1 diff --git a/stdlib/either.mli b/stdlib/either.mli new file mode 100644 index 000000000..4b3174185 --- /dev/null +++ b/stdlib/either.mli @@ -0,0 +1,114 @@ +(**************************************************************************) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(** Either type. + + @since 4.12 + + Either is the simplest and most generic sum/variant type: + a value of [('a, 'b) Either.t] is either a [Left (v : 'a)] + or a [Right (v : 'b)]. + + It is a natural choice in the API of generic functions where values + could fall in two different cases, possibly at different types, + without assigning a specific meaning to what each case should be. + + For example: + +[List.partition_map: ('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list] + + If you are looking for a parametrized type where + one alternative means success and the other means failure, + you should use the more specific type {!Result.t}. +*) + +(* Unlike [result], no [either] type is made available in Stdlib, + one needs to access [Either.t] explicitly: + + - This type is less common in typical OCaml codebases, + which prefer domain-specific variant types whose constructors + carry more meaning. + - Adding this to Stdlib would raise warnings in existing codebases + that already use a constructor named Left or Right: + + when opening a module that exports such a name, + warning 45 is raised + + adding a second constructor of the same name in scope kicks + in the disambiguation mechanisms, and warning 41 may now + be raised by existing code. + + If the use becomes more common in the future we can always + revisit this choice. +*) + +type ('a, 'b) t = Left of 'a | Right of 'b (**) +(** A value of [('a, 'b) Either.t] contains + either a value of ['a] or a value of ['b] *) + +val left : 'a -> ('a, 'b) t +(** [left v] is [Left v]. *) + +val right : 'b -> ('a, 'b) t +(** [right v] is [Right v]. *) + +val is_left : ('a, 'b) t -> bool +(** [is_left (Left v)] is [true], [is_left (Right v)] is [false]. *) + +val is_right : ('a, 'b) t -> bool +(** [is_right (Left v)] is [false], [is_right (Right v)] is [true]. *) + +val find_left : ('a, 'b) t -> 'a option +(** [find_left (Left v)] is [Some v], [find_left (Right _)] is [None] *) + +val find_right : ('a, 'b) t -> 'b option +(** [find_right (Right v)] is [Some v], [find_right (Left _)] is [None] *) + +val map_left : ('a1 -> 'a2) -> ('a1, 'b) t -> ('a2, 'b) t +(** [map_left f e] is [Left (f v)] if [e] is [Left v] + and [e] if [e] is [Right _]. *) + +val map_right : ('b1 -> 'b2) -> ('a, 'b1) t -> ('a, 'b2) t +(** [map_right f e] is [Right (f v)] if [e] is [Right v] + and [e] if [e] is [Left _]. *) + +val map : + left:('a1 -> 'a2) -> right:('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t +(** [map ~left ~right (Left v)] is [Left (left v)], + [map ~left ~right (Right v)] is [Right (right v)]. *) + +val fold : left:('a -> 'c) -> right:('b -> 'c) -> ('a, 'b) t -> 'c +(** [fold ~left ~right (Left v)] is [left v], and + [fold ~left ~right (Right v)] is [right v]. *) + +val iter : left:('a -> unit) -> right:('b -> unit) -> ('a, 'b) t -> unit +(** [iter ~left ~right (Left v)] is [left v], and + [iter ~left ~right (Right v)] is [right v]. *) + +val for_all : left:('a -> bool) -> right:('b -> bool) -> ('a, 'b) t -> bool +(** [for_all ~left ~right (Left v)] is [left v], and + [for_all ~left ~right (Right v)] is [right v]. *) + +val equal : + left:('a -> 'a -> bool) -> right:('b -> 'b -> bool) -> + ('a, 'b) t -> ('a, 'b) t -> bool +(** [equal ~left ~right e0 e1] tests equality of [e0] and [e1] using [left] + and [right] to respectively compare values wrapped by [Left _] and + [Right _]. *) + +val compare : + left:('a -> 'a -> int) -> right:('b -> 'b -> int) -> + ('a, 'b) t -> ('a, 'b) t -> int +(** [compare ~left ~right e0 e1] totally orders [e0] and [e1] using [left] and + [right] to respectively compare values wrapped by [Left _ ] and [Right _]. + [Left _] values are smaller than [Right _] values. *) diff --git a/stdlib/list.ml b/stdlib/list.ml index a624f3b43..5efd72f0f 100644 --- a/stdlib/list.ml +++ b/stdlib/list.ml @@ -283,6 +283,17 @@ let partition p l = | x :: l -> if p x then part (x :: yes) no l else part yes (x :: no) l in part [] [] l +let partition_map p l = + let rec part left right = function + | [] -> (rev left, rev right) + | x :: l -> + begin match p x with + | Either.Left v -> part (v :: left) right l + | Either.Right v -> part left (v :: right) l + end + in + part [] [] l + let rec split = function [] -> ([], []) | (x,y)::l -> @@ -538,6 +549,29 @@ let rec compare_length_with l n = compare_length_with l (n-1) ;; +(** {1 Comparison} *) + +(* Note: we are *not* shortcutting the list by using + [List.compare_lengths] first; this may be slower on long lists + immediately start with distinct elements. It is also incorrect for + [compare] below, and it is better (principle of least surprise) to + use the same approach for both functions. *) +let rec equal eq l1 l2 = + match l1, l2 with + | [], [] -> true + | [], _::_ | _::_, [] -> false + | a1::l1, a2::l2 -> eq a1 a2 && equal eq l1 l2 + +let rec compare cmp l1 l2 = + match l1, l2 with + | [], [] -> 0 + | [], _::_ -> -1 + | _::_, [] -> 1 + | a1::l1, a2::l2 -> + let c = cmp a1 a2 in + if c <> 0 then c + else compare cmp l1 l2 + (** {1 Iterators} *) let to_seq l = diff --git a/stdlib/list.mli b/stdlib/list.mli index df7385bc0..5f5ca0c49 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -357,6 +357,21 @@ val partition : ('a -> bool) -> 'a list -> 'a list * 'a list The order of the elements in the input list is preserved. *) +val partition_map : ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list +(** [partition_map f l] returns a pair of lists [(l1, l2)] such that, + for each element [x] of the input list [l]: + - if [f x] is [Left y1], then [y1] is in [l1], and + - if [f x] is [Right y2], then [y2] is in [l2]. + + The output elements are included in [l1] and [l2] in the same + relative order as the corresponding input elements in [l]. + + In particular, [partition_map (fun x -> if f x then Left x else Right x) l] + is equivalent to [partition f l]. + + @since 4.12.0 +*) + (** {1 Association lists} *) diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index 9be5a3e57..6d0a0564e 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -357,6 +357,21 @@ val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list The order of the elements in the input list is preserved. *) +val partition_map : f:('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list +(** [partition_map f l] returns a pair of lists [(l1, l2)] such that, + for each element [x] of the input list [l]: + - if [f x] is [Left y1], then [y1] is in [l1], and + - if [f x] is [Right y2], then [y2] is in [l2]. + + The output elements are included in [l1] and [l2] in the same + relative order as the corresponding input elements in [l]. + + In particular, [partition_map (fun x -> if f x then Left x else Right x) l] + is equivalent to [partition f l]. + + @since 4.12.0 +*) + (** {1 Association lists} *) diff --git a/stdlib/obj.ml b/stdlib/obj.ml index 926b33c83..f2b6e37d7 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -24,7 +24,7 @@ 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 tag : t -> int = "caml_obj_tag" [@@noalloc] 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" diff --git a/stdlib/obj.mli b/stdlib/obj.mli index bf56b012d..3270246b0 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -27,7 +27,7 @@ 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 tag : t -> int = "caml_obj_tag" [@@noalloc] external size : t -> int = "%obj_size" external reachable_words : t -> int = "caml_obj_reachable_words" (** diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index a3c58a080..52debb5b8 100644 --- a/stdlib/stdlib.ml +++ b/stdlib/stdlib.ml @@ -579,6 +579,7 @@ module Callback = Callback module Char = Char module Complex = Complex module Digest = Digest +module Either = Either module Ephemeron = Ephemeron module Filename = Filename module Float = Float diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index efd5e9a97..8afb798d6 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -998,7 +998,13 @@ val seek_out : out_channel -> int -> unit 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). *) + unspecified results). + For files opened in text mode under Windows, the returned position + is approximate (owing to end-of-line conversion); in particular, + saving the current position with [pos_out], then going back to + this position using [seek_out] will not work. For this + programming idiom to work reliably and portably, the file must be + opened in binary mode. *) val out_channel_length : out_channel -> int (** Return the size (number of characters) of the regular file @@ -1113,7 +1119,13 @@ val seek_in : in_channel -> int -> unit files of other kinds, the behavior is unspecified. *) val pos_in : in_channel -> int -(** Return the current reading position for the given channel. *) +(** Return the current reading position for the given channel. For + files opened in text mode under Windows, the returned position is + approximate (owing to end-of-line conversion); in particular, + saving the current position with [pos_in], then going back to this + position using [seek_in] will not work. For this programming + idiom to work reliably and portably, the file must be opened in + binary mode. *) val in_channel_length : in_channel -> int (** Return the size (number of characters) of the regular file @@ -1347,6 +1359,7 @@ module Callback = Callback module Char = Char module Complex = Complex module Digest = Digest +module Either = Either module Ephemeron = Ephemeron module Filename = Filename module Float = Float diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 368baa0f6..cbe8e46fc 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -94,6 +94,18 @@ external time : unit -> (float [@unboxed]) = external chdir : string -> unit = "caml_sys_chdir" (** Change the current working directory of the process. *) +external mkdir : string -> int -> unit = "caml_sys_mkdir" +(** Create a directory with the given permissions. + + @since 4.12.0 +*) + +external rmdir : string -> unit = "caml_sys_rmdir" +(** Remove an empty directory. + + @since 4.12.0 +*) + external getcwd : unit -> string = "caml_sys_getcwd" (** Return the current working directory of the process. *) diff --git a/stdlib/sys.mlp b/stdlib/sys.mlp index e89dd4584..03ffc5151 100644 --- a/stdlib/sys.mlp +++ b/stdlib/sys.mlp @@ -66,6 +66,8 @@ 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 mkdir: string -> int -> unit = "caml_sys_mkdir" +external rmdir: string -> unit = "caml_sys_rmdir" external getcwd: unit -> string = "caml_sys_getcwd" external readdir : string -> string array = "caml_sys_read_directory" diff --git a/testsuite/Makefile b/testsuite/Makefile index 5cd2d6dfa..8a88e66f5 100644 --- a/testsuite/Makefile +++ b/testsuite/Makefile @@ -16,8 +16,6 @@ .NOTPARALLEL: BASEDIR := $(shell pwd) -NO_PRINT=`$(MAKE) empty --no-print-directory >/dev/null 2>&1 \ - && echo --no-print-directory` FIND=find TOPDIR := .. @@ -75,7 +73,7 @@ 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. +# to preserve test data of successful tests. KEEP_TEST_DIR_ON_SUCCESS ?= ifeq "$(KEEP_TEST_DIR_ON_SUCCESS)" "" OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG := @@ -95,8 +93,9 @@ default: @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 TEST=f launch just this single test" @echo " one DIR=p launch the tests located in path p" + @echo " one LIST=f launch the tests listed in f (one per line)" @echo " promote DIR=p promote the reference files for the tests in p" @echo " lib build library modules" @echo " tools build test tools" @@ -110,14 +109,14 @@ default: .PHONY: all all: @rm -f $(TESTLOG) - @$(MAKE) $(NO_PRINT) new-without-report - @$(MAKE) $(NO_PRINT) report + @$(MAKE) --no-print-directory new-without-report + @$(MAKE) --no-print-directory 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 \ + $(ocamltest) -find-test-dirs tests | while IFS='' read -r dir; do \ echo Running tests from \'$$dir\' ... ; \ $(MAKE) exec-ocamltest DIR=$$dir \ OCAMLTESTENV=""; \ @@ -136,9 +135,9 @@ check-failstamp: .PHONY: all-% all-%: lib tools @for dir in tests/$**; do \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \ + $(MAKE) --no-print-directory exec-one DIR=$$dir; \ done 2>&1 | tee $(TESTLOG) - @$(MAKE) $(NO_PRINT) retries + @$(MAKE) --no-print-directory retries @$(MAKE) report # The targets below use GNU parallel to parallelize tests @@ -177,9 +176,9 @@ parallel-%: lib tools exit 1) @for dir in tests/$**; do echo $$dir; done \ | parallel --gnu --no-notice --keep-order \ - "$(MAKE) $(NO_PRINT) exec-one DIR={} 2>&1" \ + "$(MAKE) --no-print-directory exec-one DIR={} 2>&1" \ | tee $(TESTLOG) - @$(MAKE) $(NO_PRINT) retries + @$(MAKE) --no-print-directory retries @$(MAKE) report .PHONY: parallel @@ -188,27 +187,38 @@ 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 + then echo "No value set for variable 'FILE'."; \ + exit 1; \ + fi + @$(MAKE) --no-print-directory one LIST="$(FILE)" .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) + @case "$(words $(DIR) $(LIST) $(TEST))" in \ + 0) echo 'No value set for variable DIR, LIST or TEST'>&2; exit 1;; \ + 1) exit 0;; \ + *) echo 'Please specify just one of DIR, LIST or TEST'>&2; exit 1;; \ + esac + @if [ -n '$(DIR)' ] && [ ! -d '$(DIR)' ]; then \ + echo "Directory '$(DIR)' does not exist."; exit 1; \ + fi + @if [ -n '$(TEST)' ] && [ ! -e '$(TEST)' ]; then \ + echo "Test '$(TEST)' does not exist."; exit 1; \ + fi + @if [ -n '$(LIST)' ] && [ ! -e '$(LIST)' ]; then \ + echo "File '$(LIST)' does not exist."; exit 1; \ + fi + @if [ -n '$(DIR)' ] ; then \ + $(MAKE) --no-print-directory exec-one DIR=$(DIR); fi + @if [ -n '$(TEST)' ] ; then \ + TERM=dumb $(OCAMLTESTENV) $(ocamltest) $(OCAMLTESTFLAGS) $(TEST); fi @$(MAKE) check-failstamp + @if [ -n '$(LIST)' ] ; then \ + while IFS='' read -r LINE; do \ + $(MAKE) --no-print-directory exec-one DIR=$$LINE ; \ + done < $$LIST 2>&1 | tee $(TESTLOG) ; \ + $(MAKE) --no-print-directory retries ; \ + $(MAKE) report ; fi .PHONY: exec-one exec-one: @@ -229,7 +239,7 @@ 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 \ + $(ocamltest) -list-tests $(DIR) | while IFS='' read -r testfile; do \ TERM=dumb $(OCAMLTESTENV) \ $(ocamltest) $(OCAMLTESTFLAGS) $(DIR)/$$testfile || \ echo " ... testing '$$testfile' => unexpected error"; \ @@ -287,21 +297,20 @@ report: .PHONY: retry-list retry-list: - @while read LINE; do \ + @while IFS='' read -r 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) ; \ + $(MAKE) --no-print-directory clean-one DIR=$$LINE; \ + $(MAKE) --no-print-directory exec-one DIR=$$LINE 2>&1 \ + | tee -a $(TESTLOG) ; \ fi \ done <_retries; - @$(MAKE) $(NO_PRINT) retries + @$(MAKE) --no-print-directory 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 + @test `cat _retries | wc -l` -eq 0 || \ + $(MAKE) --no-print-directory retry-list @rm -f _retries - -.PHONY: empty -empty: diff --git a/testsuite/tests/basic/patmatch_for_multiple.ml b/testsuite/tests/basic/patmatch_for_multiple.ml index d3146823a..f35887425 100644 --- a/testsuite/tests/basic/patmatch_for_multiple.ml +++ b/testsuite/tests/basic/patmatch_for_multiple.ml @@ -12,16 +12,16 @@ match (3, 2, 1) with ;; [%%expect{| (let - (*match*/88 = 3 - *match*/89 = 2 - *match*/90 = 1 - *match*/91 = *match*/88 + (*match*/89 = 3 + *match*/90 = 2 + *match*/91 = 1 *match*/92 = *match*/89 - *match*/93 = *match*/90) + *match*/93 = *match*/90 + *match*/94 = *match*/91) (catch (catch - (catch (if (!= *match*/92 3) (exit 3) (exit 1)) with (3) - (if (!= *match*/91 1) (exit 2) (exit 1))) + (catch (if (!= *match*/93 3) (exit 3) (exit 1)) with (3) + (if (!= *match*/92 1) (exit 2) (exit 1))) with (2) 0) with (1) 1)) - : bool = false @@ -36,24 +36,25 @@ match (3, 2, 1) with ;; [%%expect{| (let - (*match*/96 = 3 - *match*/97 = 2 - *match*/98 = 1 - *match*/99 = (makeblock 0 *match*/96 *match*/97 *match*/98)) + (*match*/97 = 3 + *match*/98 = 2 + *match*/99 = 1 + *match*/100 = (makeblock 0 *match*/97 *match*/98 *match*/99)) (catch (catch - (let (*match*/100 =a (field 0 *match*/99)) + (let (*match*/101 =a (field 0 *match*/100)) (catch - (let (*match*/101 =a (field 1 *match*/99)) - (if (!= *match*/101 3) (exit 7) - (let (*match*/102 =a (field 2 *match*/99)) (exit 5 *match*/99)))) + (let (*match*/102 =a (field 1 *match*/100)) + (if (!= *match*/102 3) (exit 7) + (let (*match*/103 =a (field 2 *match*/100)) + (exit 5 *match*/100)))) with (7) - (if (!= *match*/100 1) (exit 6) + (if (!= *match*/101 1) (exit 6) (let - (*match*/104 =a (field 2 *match*/99) - *match*/103 =a (field 1 *match*/99)) - (exit 5 *match*/99))))) + (*match*/105 =a (field 2 *match*/100) + *match*/104 =a (field 1 *match*/100)) + (exit 5 *match*/100))))) with (6) 0) - with (5 x/94) (seq (ignore x/94) 1))) + with (5 x/95) (seq (ignore x/95) 1))) - : bool = false |}];; diff --git a/testsuite/tests/callback/callbackprim.c b/testsuite/tests/callback/callbackprim.c index 45879a019..4a0ad05c3 100644 --- a/testsuite/tests/callback/callbackprim.c +++ b/testsuite/tests/callback/callbackprim.c @@ -13,6 +13,7 @@ /* */ /**************************************************************************/ +#include #include "caml/mlvalues.h" #include "caml/memory.h" #include "caml/callback.h" @@ -67,3 +68,9 @@ value mycamlparam (value v, value fun, value arg) v = x; CAMLreturn (v); } + +value raise_sigusr1(value unused) +{ + raise(SIGUSR1); + return Val_unit; +} diff --git a/testsuite/tests/callback/signals_alloc.ml b/testsuite/tests/callback/signals_alloc.ml index ae5f0d7f1..27ed2f7da 100644 --- a/testsuite/tests/callback/signals_alloc.ml +++ b/testsuite/tests/callback/signals_alloc.ml @@ -1,11 +1,11 @@ (* TEST include unix + modules = "callbackprim.c" * libunix ** bytecode ** native *) - -let pid = Unix.getpid () +external raise_sigusr1 : unit -> unit = "raise_sigusr1" let do_test () = let seen_states = Array.make 5 (-1) in @@ -19,12 +19,13 @@ let do_test () = 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; + raise_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|]) + Array.iter (Printf.printf "%d") seen_states; + print_newline () let () = for _ = 0 to 10 do do_test () done; diff --git a/testsuite/tests/callback/signals_alloc.reference b/testsuite/tests/callback/signals_alloc.reference index d86bac9de..3e5c37f94 100644 --- a/testsuite/tests/callback/signals_alloc.reference +++ b/testsuite/tests/callback/signals_alloc.reference @@ -1 +1,12 @@ +01234 +01234 +01234 +01234 +01234 +01234 +01234 +01234 +01234 +01234 +01234 OK diff --git a/testsuite/tests/callback/tcallback.ml b/testsuite/tests/callback/tcallback.ml index 9e4e09f5c..cf9568a8f 100644 --- a/testsuite/tests/callback/tcallback.ml +++ b/testsuite/tests/callback/tcallback.ml @@ -52,17 +52,14 @@ let sighandler signo = (* 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] +external raise_sigusr1 : unit -> unit = "raise_sigusr1" [@@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; + not be spilled on the stack, hence we use a [@@noalloc] stub *) + raise_sigusr1 (); (* Allocate some more so that the signal will be tested *) let u = (s, s) in fst u diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference index e85e57739..f17a66947 100644 --- a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference +++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference @@ -1,75 +1,75 @@ [ - structure_item (test_locations.ml[42,1350+0]..[44,1388+34]) + structure_item (test_locations.ml[17,534+0]..[19,572+34]) Pstr_value Rec [ - pattern (test_locations.ml[42,1350+8]..[42,1350+11]) - Ppat_var "fib" (test_locations.ml[42,1350+8]..[42,1350+11]) - expression (test_locations.ml[42,1350+14]..[44,1388+34]) + pattern (test_locations.ml[17,534+8]..[17,534+11]) + Ppat_var "fib" (test_locations.ml[17,534+8]..[17,534+11]) + expression (test_locations.ml[17,534+14]..[19,572+34]) Pexp_function [ - pattern (test_locations.ml[43,1373+4]..[43,1373+9]) + pattern (test_locations.ml[18,557+4]..[18,557+9]) Ppat_or - pattern (test_locations.ml[43,1373+4]..[43,1373+5]) + pattern (test_locations.ml[18,557+4]..[18,557+5]) Ppat_constant PConst_int (0,None) - pattern (test_locations.ml[43,1373+8]..[43,1373+9]) + pattern (test_locations.ml[18,557+8]..[18,557+9]) Ppat_constant PConst_int (1,None) - expression (test_locations.ml[43,1373+13]..[43,1373+14]) + expression (test_locations.ml[18,557+13]..[18,557+14]) Pexp_constant PConst_int (1,None) - pattern (test_locations.ml[44,1388+4]..[44,1388+5]) - Ppat_var "n" (test_locations.ml[44,1388+4]..[44,1388+5]) - expression (test_locations.ml[44,1388+9]..[44,1388+34]) + pattern (test_locations.ml[19,572+4]..[19,572+5]) + Ppat_var "n" (test_locations.ml[19,572+4]..[19,572+5]) + expression (test_locations.ml[19,572+9]..[19,572+34]) Pexp_apply - expression (test_locations.ml[44,1388+21]..[44,1388+22]) - Pexp_ident "+" (test_locations.ml[44,1388+21]..[44,1388+22]) + expression (test_locations.ml[19,572+21]..[19,572+22]) + Pexp_ident "+" (test_locations.ml[19,572+21]..[19,572+22]) [ Nolabel - expression (test_locations.ml[44,1388+9]..[44,1388+20]) + expression (test_locations.ml[19,572+9]..[19,572+20]) Pexp_apply - expression (test_locations.ml[44,1388+9]..[44,1388+12]) - Pexp_ident "fib" (test_locations.ml[44,1388+9]..[44,1388+12]) + expression (test_locations.ml[19,572+9]..[19,572+12]) + Pexp_ident "fib" (test_locations.ml[19,572+9]..[19,572+12]) [ Nolabel - expression (test_locations.ml[44,1388+13]..[44,1388+20]) + expression (test_locations.ml[19,572+13]..[19,572+20]) Pexp_apply - expression (test_locations.ml[44,1388+16]..[44,1388+17]) - Pexp_ident "-" (test_locations.ml[44,1388+16]..[44,1388+17]) + expression (test_locations.ml[19,572+16]..[19,572+17]) + Pexp_ident "-" (test_locations.ml[19,572+16]..[19,572+17]) [ Nolabel - expression (test_locations.ml[44,1388+14]..[44,1388+15]) - Pexp_ident "n" (test_locations.ml[44,1388+14]..[44,1388+15]) + expression (test_locations.ml[19,572+14]..[19,572+15]) + Pexp_ident "n" (test_locations.ml[19,572+14]..[19,572+15]) Nolabel - expression (test_locations.ml[44,1388+18]..[44,1388+19]) + expression (test_locations.ml[19,572+18]..[19,572+19]) Pexp_constant PConst_int (1,None) ] ] Nolabel - expression (test_locations.ml[44,1388+23]..[44,1388+34]) + expression (test_locations.ml[19,572+23]..[19,572+34]) Pexp_apply - expression (test_locations.ml[44,1388+23]..[44,1388+26]) - Pexp_ident "fib" (test_locations.ml[44,1388+23]..[44,1388+26]) + expression (test_locations.ml[19,572+23]..[19,572+26]) + Pexp_ident "fib" (test_locations.ml[19,572+23]..[19,572+26]) [ Nolabel - expression (test_locations.ml[44,1388+27]..[44,1388+34]) + expression (test_locations.ml[19,572+27]..[19,572+34]) Pexp_apply - expression (test_locations.ml[44,1388+30]..[44,1388+31]) - Pexp_ident "-" (test_locations.ml[44,1388+30]..[44,1388+31]) + expression (test_locations.ml[19,572+30]..[19,572+31]) + Pexp_ident "-" (test_locations.ml[19,572+30]..[19,572+31]) [ Nolabel - expression (test_locations.ml[44,1388+28]..[44,1388+29]) - Pexp_ident "n" (test_locations.ml[44,1388+28]..[44,1388+29]) + expression (test_locations.ml[19,572+28]..[19,572+29]) + Pexp_ident "n" (test_locations.ml[19,572+28]..[19,572+29]) Nolabel - expression (test_locations.ml[44,1388+32]..[44,1388+33]) + expression (test_locations.ml[19,572+32]..[19,572+33]) Pexp_constant PConst_int (2,None) ] ] @@ -80,78 +80,78 @@ let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2)) [ - structure_item (test_locations.ml[42,1350+0]..test_locations.ml[44,1388+34]) + structure_item (test_locations.ml[17,534+0]..test_locations.ml[19,572+34]) Tstr_value Rec [ - pattern (test_locations.ml[42,1350+8]..test_locations.ml[42,1350+11]) + pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11]) Tpat_var "fib" - expression (test_locations.ml[42,1350+14]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34]) Texp_function Nolabel [ - pattern (test_locations.ml[43,1373+4]..test_locations.ml[43,1373+9]) + pattern (test_locations.ml[18,557+4]..test_locations.ml[18,557+9]) Tpat_or - pattern (test_locations.ml[43,1373+4]..test_locations.ml[43,1373+5]) + pattern (test_locations.ml[18,557+4]..test_locations.ml[18,557+5]) Tpat_constant Const_int 0 - pattern (test_locations.ml[43,1373+8]..test_locations.ml[43,1373+9]) + pattern (test_locations.ml[18,557+8]..test_locations.ml[18,557+9]) Tpat_constant Const_int 1 - expression (test_locations.ml[43,1373+13]..test_locations.ml[43,1373+14]) + expression (test_locations.ml[18,557+13]..test_locations.ml[18,557+14]) Texp_constant Const_int 1 - pattern (test_locations.ml[44,1388+4]..test_locations.ml[44,1388+5]) + pattern (test_locations.ml[19,572+4]..test_locations.ml[19,572+5]) Tpat_var "n" - expression (test_locations.ml[44,1388+9]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+34]) Texp_apply - expression (test_locations.ml[44,1388+21]..test_locations.ml[44,1388+22]) + expression (test_locations.ml[19,572+21]..test_locations.ml[19,572+22]) Texp_ident "Stdlib!.+" [ Nolabel - expression (test_locations.ml[44,1388+9]..test_locations.ml[44,1388+20]) + expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+20]) Texp_apply - expression (test_locations.ml[44,1388+9]..test_locations.ml[44,1388+12]) + expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+12]) Texp_ident "fib" [ Nolabel - expression (test_locations.ml[44,1388+13]..test_locations.ml[44,1388+20]) + expression (test_locations.ml[19,572+13]..test_locations.ml[19,572+20]) Texp_apply - expression (test_locations.ml[44,1388+16]..test_locations.ml[44,1388+17]) + expression (test_locations.ml[19,572+16]..test_locations.ml[19,572+17]) Texp_ident "Stdlib!.-" [ Nolabel - expression (test_locations.ml[44,1388+14]..test_locations.ml[44,1388+15]) + expression (test_locations.ml[19,572+14]..test_locations.ml[19,572+15]) Texp_ident "n" Nolabel - expression (test_locations.ml[44,1388+18]..test_locations.ml[44,1388+19]) + expression (test_locations.ml[19,572+18]..test_locations.ml[19,572+19]) Texp_constant Const_int 1 ] ] Nolabel - expression (test_locations.ml[44,1388+23]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+34]) Texp_apply - expression (test_locations.ml[44,1388+23]..test_locations.ml[44,1388+26]) + expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+26]) Texp_ident "fib" [ Nolabel - expression (test_locations.ml[44,1388+27]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[19,572+27]..test_locations.ml[19,572+34]) Texp_apply - expression (test_locations.ml[44,1388+30]..test_locations.ml[44,1388+31]) + expression (test_locations.ml[19,572+30]..test_locations.ml[19,572+31]) Texp_ident "Stdlib!.-" [ Nolabel - expression (test_locations.ml[44,1388+28]..test_locations.ml[44,1388+29]) + expression (test_locations.ml[19,572+28]..test_locations.ml[19,572+29]) Texp_ident "n" Nolabel - expression (test_locations.ml[44,1388+32]..test_locations.ml[44,1388+33]) + expression (test_locations.ml[19,572+32]..test_locations.ml[19,572+33]) Texp_constant Const_int 2 ] ] @@ -164,13 +164,13 @@ let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2)) (letrec (fib (function n[int] : int - (funct-body Test_locations.fib test_locations.ml(42):1364-1422 + (funct-body Test_locations.fib test_locations.ml(17):548-606 (if (isout 1 n) - (before Test_locations.fib test_locations.ml(44):1397-1422 + (before Test_locations.fib test_locations.ml(19):581-606 (+ - (after Test_locations.fib test_locations.ml(44):1397-1408 + (after Test_locations.fib test_locations.ml(19):581-592 (apply fib (- n 1))) - (after Test_locations.fib test_locations.ml(44):1411-1422 + (after Test_locations.fib test_locations.ml(19):595-606 (apply fib (- n 2))))) - (before Test_locations.fib test_locations.ml(43):1386-1387 1))))) + (before Test_locations.fib test_locations.ml(18):570-571 1))))) (pseudo (makeblock 0 fib)))) diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference deleted file mode 100644 index 53054491e..000000000 --- a/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference +++ /dev/null @@ -1,31 +0,0 @@ - -cmm: -(data) -(data - int 3063 - "camlTest_locations__1": - addr "camlTest_locations__fib_81" - int 72057594037927941) -(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_81 (n: val) - (if ( 1 diff --git a/testsuite/tests/generalized-open/gpr1506.ml b/testsuite/tests/generalized-open/gpr1506.ml index 52ff509d3..c36eaafe6 100644 --- a/testsuite/tests/generalized-open/gpr1506.ml +++ b/testsuite/tests/generalized-open/gpr1506.ml @@ -103,9 +103,9 @@ include struct open struct type t = T end let x = T end Line 1, characters 15-41: 1 | include struct open struct type t = T end let x = T end ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The type t/150 introduced by this open appears in the signature +Error: The type t/151 introduced by this open appears in the signature Line 1, characters 46-47: - The value x has no valid type if t/150 is hidden + The value x has no valid type if t/151 is hidden |}];; module A = struct @@ -123,9 +123,9 @@ Lines 3-6, characters 4-7: 4 | type t = T 5 | let x = T 6 | end -Error: The type t/155 introduced by this open appears in the signature +Error: The type t/156 introduced by this open appears in the signature Line 7, characters 8-9: - The value y has no valid type if t/155 is hidden + The value y has no valid type if t/156 is hidden |}];; module A = struct @@ -142,9 +142,9 @@ Lines 3-5, characters 4-7: 3 | ....open struct 4 | type t = T 5 | end -Error: The type t/160 introduced by this open appears in the signature +Error: The type t/161 introduced by this open appears in the signature Line 6, characters 8-9: - The value y has no valid type if t/160 is hidden + The value y has no valid type if t/161 is hidden |}] (* It was decided to not allow this anymore. *) diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml index 57536d67b..b144b2e6e 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.ml +++ b/testsuite/tests/lib-bigarray/bigarrays.ml @@ -28,6 +28,12 @@ let test test_number answer correct_answer = printf " %d..." test_number end +let with_trace f = + let events = ref [] in + let trace e = events := e :: !events in + let v = f trace in + (v, List.rev !events) + (* One-dimensional arrays *) (* flambda can cause some of these values not to be reclaimed by the Gc, which @@ -489,6 +495,26 @@ let tests () = 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); + testing_function "init"; + let check1 arr graph = List.for_all (fun (i, fi) -> arr.{i} = fi) graph in + + let ba, log = with_trace @@ fun trace -> + Array1.init int c_layout 5 (fun x -> trace (x,x); x) in + test 1 log [0,0; + 1,1; + 2,2; + 3,3; + 4,4]; + test 2 true (check1 ba log); + + let ba, log = with_trace @@ fun trace -> + Array1.init int fortran_layout 5 (fun x -> trace (x,x); x) in + test 3 log [1,1; + 2,2; + 3,3; + 4,4; + 5,5]; + test 4 true (check1 ba log); (* Bi-dimensional arrays *) @@ -651,6 +677,25 @@ let tests () = test 8 (Array2.slice_right a 3) (from_list_fortran int [1003;2003;3003;4003;5003]); + testing_function "init"; + let check2 arr graph = List.for_all (fun ((i,j), fij) -> arr.{i,j} = fij) graph in + + let ba, log = with_trace @@ fun trace -> + Array2.init int c_layout 4 2 + (fun x y -> let v = 10*x + y in trace ((x,y),v); v) in + test 1 log [(0,0), 00; (0,1), 01; + (1,0), 10; (1,1), 11; + (2,0), 20; (2,1), 21; + (3,0), 30; (3,1), 31]; + test 2 true (check2 ba log); + + let ba, log = with_trace @@ fun trace -> + Array2.init int fortran_layout 4 2 + (fun x y -> let v = 10*x + y in trace ((x,y),v); v) in + test 3 log [(1,1), 11; (2,1), 21; (3,1), 31; (4,1), 41; + (1,2), 12; (2,2), 22; (3,2), 32; (4,2), 42]; + test 4 true (check2 ba log); + (* Tri-dimensional arrays *) print_newline(); @@ -778,10 +823,125 @@ let tests () = 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 "init"; + let check3 arr graph = + List.for_all (fun ((i,j,k), fijk) -> arr.{i,j,k} = fijk) graph in + + let ba, log = with_trace @@ fun trace -> + Array3.init int c_layout 4 2 3 + (fun x y z -> let v = 100*x + 10*y + z in trace ((x,y,z),v); v) in + test 1 log [(0,0,0), 000; (0,0,1), 001; (0,0,2), 002; + (0,1,0), 010; (0,1,1), 011; (0,1,2), 012; + + (1,0,0), 100; (1,0,1), 101; (1,0,2), 102; + (1,1,0), 110; (1,1,1), 111; (1,1,2), 112; + + (2,0,0), 200; (2,0,1), 201; (2,0,2), 202; + (2,1,0), 210; (2,1,1), 211; (2,1,2), 212; + + (3,0,0), 300; (3,0,1), 301; (3,0,2), 302; + (3,1,0), 310; (3,1,1), 311; (3,1,2), 312]; + test 2 true (check3 ba log); + + let ba, log = with_trace @@ fun trace -> + Array3.init int fortran_layout 4 2 3 + (fun x y z -> let v = 100*x + 10*y + z in trace ((x,y,z), v); v) in + test 3 log [(1,1,1), 111; (2,1,1), 211; (3,1,1), 311; (4,1,1), 411; + (1,2,1), 121; (2,2,1), 221; (3,2,1), 321; (4,2,1), 421; + + (1,1,2), 112; (2,1,2), 212; (3,1,2), 312; (4,1,2), 412; + (1,2,2), 122; (2,2,2), 222; (3,2,2), 322; (4,2,2), 422; + + (1,1,3), 113; (2,1,3), 213; (3,1,3), 313; (4,1,3), 413; + (1,2,3), 123; (2,2,3), 223; (3,2,3), 323; (4,2,3), 423]; + test 4 true (check3 ba log); + 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)); + testing_function "init"; + let checkgen arr graph = + List.for_all (fun (i, fi) -> Genarray.get arr i = fi) graph in + + let ba, log = with_trace @@ fun trace -> + Genarray.init int c_layout [|4; 2; 3; 2|] + (fun i -> let v = 1000*i.(0) + 100*i.(1) + 10*i.(2) + i.(3) in + trace (Array.copy i, v); v) in + test 1 log [[|0;0;0;0|], 0000; [|0;0;0;1|], 0001; + [|0;0;1;0|], 0010; [|0;0;1;1|], 0011; + [|0;0;2;0|], 0020; [|0;0;2;1|], 0021; + + [|0;1;0;0|], 0100; [|0;1;0;1|], 0101; + [|0;1;1;0|], 0110; [|0;1;1;1|], 0111; + [|0;1;2;0|], 0120; [|0;1;2;1|], 0121; + + [|1;0;0;0|], 1000; [|1;0;0;1|], 1001; + [|1;0;1;0|], 1010; [|1;0;1;1|], 1011; + [|1;0;2;0|], 1020; [|1;0;2;1|], 1021; + + [|1;1;0;0|], 1100; [|1;1;0;1|], 1101; + [|1;1;1;0|], 1110; [|1;1;1;1|], 1111; + [|1;1;2;0|], 1120; [|1;1;2;1|], 1121; + + [|2;0;0;0|], 2000; [|2;0;0;1|], 2001; + [|2;0;1;0|], 2010; [|2;0;1;1|], 2011; + [|2;0;2;0|], 2020; [|2;0;2;1|], 2021; + + [|2;1;0;0|], 2100; [|2;1;0;1|], 2101; + [|2;1;1;0|], 2110; [|2;1;1;1|], 2111; + [|2;1;2;0|], 2120; [|2;1;2;1|], 2121; + + [|3;0;0;0|], 3000; [|3;0;0;1|], 3001; + [|3;0;1;0|], 3010; [|3;0;1;1|], 3011; + [|3;0;2;0|], 3020; [|3;0;2;1|], 3021; + + [|3;1;0;0|], 3100; [|3;1;0;1|], 3101; + [|3;1;1;0|], 3110; [|3;1;1;1|], 3111; + [|3;1;2;0|], 3120; [|3;1;2;1|], 3121;]; + test 2 true (checkgen ba log); + + let ba, log = with_trace @@ fun trace -> + Genarray.init int fortran_layout [|4; 2; 3; 2|] + (fun i -> let v = 1000*i.(0) + 100*i.(1) + 10*i.(2) + i.(3) in + trace (Array.copy i, v); v) in + test 3 log [[|1;1;1;1|], 1111; [|2;1;1;1|], 2111; + [|3;1;1;1|], 3111; [|4;1;1;1|], 4111; + + [|1;2;1;1|], 1211; [|2;2;1;1|], 2211; + [|3;2;1;1|], 3211; [|4;2;1;1|], 4211; + + [|1;1;2;1|], 1121; [|2;1;2;1|], 2121; + [|3;1;2;1|], 3121; [|4;1;2;1|], 4121; + + [|1;2;2;1|], 1221; [|2;2;2;1|], 2221; + [|3;2;2;1|], 3221; [|4;2;2;1|], 4221; + + [|1;1;3;1|], 1131; [|2;1;3;1|], 2131; + [|3;1;3;1|], 3131; [|4;1;3;1|], 4131; + + [|1;2;3;1|], 1231; [|2;2;3;1|], 2231; + [|3;2;3;1|], 3231; [|4;2;3;1|], 4231; + + [|1;1;1;2|], 1112; [|2;1;1;2|], 2112; + [|3;1;1;2|], 3112; [|4;1;1;2|], 4112; + + [|1;2;1;2|], 1212; [|2;2;1;2|], 2212; + [|3;2;1;2|], 3212; [|4;2;1;2|], 4212; + + [|1;1;2;2|], 1122; [|2;1;2;2|], 2122; + [|3;1;2;2|], 3122; [|4;1;2;2|], 4122; + + [|1;2;2;2|], 1222; [|2;2;2;2|], 2222; + [|3;2;2;2|], 3222; [|4;2;2;2|], 4222; + + [|1;1;3;2|], 1132; [|2;1;3;2|], 2132; + [|3;1;3;2|], 3132; [|4;1;3;2|], 4132; + + [|1;2;3;2|], 1232; [|2;2;3;2|], 2232; + [|3;2;3;2|], 3232; [|4;2;3;2|], 4232]; + test 4 true (checkgen ba log); + (* Zero-dimensional arrays *) testing_function "------ Array0 --------"; testing_function "create/set/get"; @@ -886,6 +1046,12 @@ let tests () = {im=0.5;re= -2.0}, {im=0.5;re= -2.0}; {im=3.1415;re=1.2345678}, {im=3.1415;re=1.2345678}]); + testing_function "init"; + let ba = Array0.init int c_layout 10 in + test 1 ba (Array0.of_value int c_layout 10); + + let ba = Array0.init int fortran_layout 10 in + test 2 ba (Array0.of_value int fortran_layout 10); (* Kind size *) testing_function "kind_size_in_bytes"; @@ -945,7 +1111,7 @@ let tests () = test 9 (Genarray.get c [|0|]) 3; test 10 (Genarray.get (Genarray.slice_left c [|0|]) [||]) 3; -(* I/O *) + (* I/O *) print_newline(); testing_function "------ I/O --------"; diff --git a/testsuite/tests/lib-bigarray/bigarrays.reference b/testsuite/tests/lib-bigarray/bigarrays.reference index 1c80e50e2..6162fb38a 100644 --- a/testsuite/tests/lib-bigarray/bigarrays.reference +++ b/testsuite/tests/lib-bigarray/bigarrays.reference @@ -21,6 +21,8 @@ blit, fill 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... slice 1... 2... 3... 6... 7... 8... +init + 1... 2... 3... 4... ------ Array2 -------- @@ -38,6 +40,8 @@ sub 1... 2... slice 1... 2... 3... 4... 5... 6... 7... 8... +init + 1... 2... 3... 4... ------ Array3 -------- @@ -53,12 +57,18 @@ size_in_bytes_three 1... slice1 1... 2... 3... 4... 5... 6... 7... +init + 1... 2... 3... 4... size_in_bytes_general 1... +init + 1... 2... 3... 4... ------ Array0 -------- create/set/get 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... +init + 1... 2... kind_size_in_bytes 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... diff --git a/testsuite/tests/lib-channels/in_channel_length.ml b/testsuite/tests/lib-channels/in_channel_length.ml new file mode 100644 index 000000000..0bdeae4e7 --- /dev/null +++ b/testsuite/tests/lib-channels/in_channel_length.ml @@ -0,0 +1,20 @@ +(* TEST *) + +let len = 15000 +let rounds = 10 + +let () = + let oc = open_out "data.txt" in + for i = 1 to rounds do + Printf.fprintf oc "%s\n%!" (String.make len 'x'); + done; + close_out oc; + let ic = open_in "data.txt" in + let l1 = in_channel_length ic in + for i = 1 to rounds do + let s = input_line ic in + assert (String.length s = len); + let l = in_channel_length ic in + assert (l = l1) + done; + close_in ic diff --git a/testsuite/tests/lib-channels/seek_in.ml b/testsuite/tests/lib-channels/seek_in.ml new file mode 100644 index 000000000..33f7146bb --- /dev/null +++ b/testsuite/tests/lib-channels/seek_in.ml @@ -0,0 +1,19 @@ +(* TEST *) + +let () = + let oc = open_out_bin "data.txt" in + output_string oc "0\r\n1\r\n"; + close_out oc; + (* Open in text mode to trigger EOL conversion under Windows *) + let ic = open_in "data.txt" in + ignore (input_line ic); + seek_in ic 3; + (* Normally we should be looking at "1\r\n", which will be read as + "1" under Windows because of EOL conversion and "1\r" otherwise. + What goes wrong with the old implementation of seek_in is that + we have "0\n\1\n" in the channel buffer and have read "0\n" already, + so we think we are at position 2, and the seek to position 3 + just advances by one in the buffer, pointing to "\n" instead of "1\n". *) + let l = input_line ic in + close_in ic; + assert (l = "1" || l = "1\r") diff --git a/testsuite/tests/lib-either/test.ml b/testsuite/tests/lib-either/test.ml new file mode 100644 index 000000000..4ca9712ad --- /dev/null +++ b/testsuite/tests/lib-either/test.ml @@ -0,0 +1,108 @@ +(* TEST + * expect +*) + +open Either;; + +[left 1; right true];; +[%%expect {| +- : (int, bool) Either.t list = [Left 1; Right true] +|}];; + +List.map is_left [left 1; right true];; +[%%expect {| +- : bool list = [true; false] +|}];; + +List.map is_right [left 1; right true];; +[%%expect {| +- : bool list = [false; true] +|}];; + +[find_left (Left 1); find_left (Right 1)];; +[%%expect {| +- : int option list = [Some 1; None] +|}];; + +[find_right (Left 1); find_right (Right 1)];; +[%%expect {| +- : int option list = [None; Some 1] +|}];; + +[map_left succ (Left 1); map_left succ (Right true)];; +[%%expect {| +- : (int, bool) Either.t list = [Left 2; Right true] +|}];; + +[map_right succ (Left ()); map_right succ (Right 2)];; +[%%expect {| +- : (unit, int) Either.t list = [Left (); Right 3] +|}];; + +[map succ not (Left 1); map succ not (Right true)];; +[%%expect {| +- : (int, bool) Either.t list = [Left 2; Right false] +|}];; + +[fold ~left:succ ~right:int_of_string (Left 1); + fold ~left:succ ~right:int_of_string (Right "2")];; +[%%expect {| +- : int list = [2; 2] +|}];; + +let li = ref [] in +let add to_str x = li := to_str x :: !li in +iter ~left:(add Fun.id) ~right:(add string_of_int) (Left "foo"); +iter ~left:(add Fun.id) ~right:(add string_of_int) (Right 2); +List.rev !li;; +[%%expect {| +- : string list = ["foo"; "2"] +|}];; + +( + for_all ~left:((=) 1) ~right:((=) "foo") (Left 1), + for_all ~left:((=) 1) ~right:((=) "foo") (Right "foo"), + for_all ~left:((=) 1) ~right:((=) "foo") (Left 2), + for_all ~left:((=) 1) ~right:((=) "foo") (Right "bar") +);; +[%%expect {| +- : bool * bool * bool * bool = (true, true, false, false) +|}];; + +equal ~left:(=) ~right:(=) (Left 1) (Left 1), +equal ~left:(=) ~right:(=) (Right true) (Right true);; +[%%expect {| +- : bool * bool = (true, true) +|}];; + +(equal ~left:(=) ~right:(=) (Left 1) (Left 2), + equal ~left:(=) ~right:(=) (Right true) (Right false), + equal ~left:(=) ~right:(=) (Left 1) (Right true), + equal ~left:(=) ~right:(=) (Right 1) (Left true));; +[%%expect {| +- : bool * bool * bool * bool = (false, false, false, false) +|}];; + +equal ~left:(fun _ _ -> false) ~right:(=) (Left 1) (Left 1), +equal ~left:(=) ~right:(fun _ _ -> false) (Right true) (Right true);; +[%%expect {| +- : bool * bool = (false, false) +|}];; + +let cmp = Stdlib.compare in +( + (compare ~left:cmp ~right:cmp (Left 0) (Left 1), + compare ~left:cmp ~right:cmp (Left 1) (Left 1), + compare ~left:cmp ~right:cmp (Left 1) (Left 0)), + + (compare ~left:cmp ~right:cmp (Right 0) (Right 1), + compare ~left:cmp ~right:cmp (Right 1) (Right 1), + compare ~left:cmp ~right:cmp (Right 1) (Right 0)), + + (compare ~left:cmp ~right:cmp (Left 1) (Right true), + compare ~left:cmp ~right:cmp (Right 1) (Left true)) +);; +[%%expect {| +- : (int * int * int) * (int * int * int) * (int * int) = +((-1, 0, 1), (-1, 0, 1), (-1, 1)) +|}];; diff --git a/testsuite/tests/lib-floatarray/floatarray.ml b/testsuite/tests/lib-floatarray/floatarray.ml index 7c0434f78..60e85af85 100644 --- a/testsuite/tests/lib-floatarray/floatarray.ml +++ b/testsuite/tests/lib-floatarray/floatarray.ml @@ -42,6 +42,14 @@ module type S = sig val map_from_array : ('a -> float) -> 'a array -> t val unsafe_get : t -> int -> float val unsafe_set : t -> int -> float -> unit + + (* From Sys, rather than Float.Array *) + val max_length : int +end + +module Flat_float_array : S = struct + include Stdlib.Float.Array + let max_length = Sys.max_floatarray_length end (* module [Array] specialized to [float] and with a few changes, @@ -53,6 +61,7 @@ module Float_array : S = struct let map_from_array f a = map f a let mem_ieee x a = exists ((=) x) a type t = float array + let max_length = Sys.max_array_length end module Test (A : S) : sig end = struct @@ -91,9 +100,9 @@ module Test (A : S) : sig end = struct 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 A.create (A.max_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); + check_inval (fun i -> A.make i 1.0) (A.max_length + 1); (* [length] *) let test_length l = assert (l = (A.length (A.create l))) in @@ -109,7 +118,7 @@ module Test (A : S) : sig end = struct 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); + check_inval (fun i -> A.init i Float.of_int) (A.max_length + 1); (* [append] *) let check m n = @@ -524,5 +533,5 @@ module Test (A : S) : sig end = struct end (* We run the same tests on [Float.Array] and [Array]. *) -module T1 = Test (Stdlib.Float.Array) +module T1 = Test (Flat_float_array) module T2 = Test (Float_array) diff --git a/testsuite/tests/lib-list/test.ml b/testsuite/tests/lib-list/test.ml index d0b75e6a7..8f7be225c 100644 --- a/testsuite/tests/lib-list/test.ml +++ b/testsuite/tests/lib-list/test.ml @@ -1,12 +1,20 @@ (* TEST *) +let is_even x = (x mod 2 = 0) + let string_of_even_opt x = - if x mod 2 = 0 then + if is_even x then Some (string_of_int x) else None +let string_of_even_or_int x = + if is_even x then + Either.Left (string_of_int x) + else + Either.Right x + (* Standard test case *) let () = let l = List.init 10 (fun x -> x) in @@ -27,6 +35,24 @@ let () = assert (not (List.exists (fun a -> a > 9) l)); assert (List.exists (fun _ -> true) l); + assert (List.equal (=) [1; 2; 3] [1; 2; 3]); + assert (not (List.equal (=) [1; 2; 3] [1; 2])); + assert (not (List.equal (=) [1; 2; 3] [1; 3; 2])); + + (* The current implementation of List.equal calls the comparison + function even for different-size lists. This is not part of the + specification, so it would be valid to change this behavior, but + we don't want to change it without noticing so here is a test for + it. *) + assert (let c = ref 0 in + not (List.equal (fun _ _ -> incr c; true) [1; 2] [1; 2; 3]) + && !c = 2); + + assert (List.compare compare [1; 2; 3] [1; 2; 3] = 0); + assert (List.compare compare [1; 2; 3] [1; 2] > 0); + assert (List.compare compare [1; 2; 3] [1; 3; 2] < 0); + assert (List.compare compare [3] [2; 1] > 0); + begin let f ~limit a = if a >= limit then Some (a, limit) else None in assert (List.find_map (f ~limit:3) [] = None); @@ -36,6 +62,11 @@ let () = assert (List.filteri (fun i _ -> i < 2) (List.rev l) = [9; 8]); + assert (List.partition is_even [1; 2; 3; 4; 5] + = ([2; 4], [1; 3; 5])); + assert (List.partition_map string_of_even_or_int [1; 2; 3; 4; 5] + = (["2"; "4"], [1; 3; 5])); + assert (List.compare_lengths [] [] = 0); assert (List.compare_lengths [1;2] ['a';'b'] = 0); assert (List.compare_lengths [] [1;2] < 0); diff --git a/testsuite/tests/lib-random/rand.ml b/testsuite/tests/lib-random/rand.ml index 50e74d13d..1664907de 100644 --- a/testsuite/tests/lib-random/rand.ml +++ b/testsuite/tests/lib-random/rand.ml @@ -4,12 +4,12 @@ (* 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. + once in 2^30 runs. *) let () = Random.self_init (); - let x = Random.int 10000 in + let x = Random.bits () in Random.self_init (); - let y = Random.int 10000 in + let y = Random.bits () in if x = y then print_endline "FAILED" else print_endline "PASSED" diff --git a/testsuite/tests/lib-systhreads/eintr.ml b/testsuite/tests/lib-systhreads/eintr.ml new file mode 100644 index 000000000..5c0a4d045 --- /dev/null +++ b/testsuite/tests/lib-systhreads/eintr.ml @@ -0,0 +1,91 @@ +(* TEST + +* hassysthreads +include systhreads +** not-windows +*** bytecode +*** native +*) + +let signals_requested = Atomic.make 0 +let signal_delay = 0.1 +let _ = Thread.create (fun () -> + let signals_sent = ref 0 in + ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigint]); + while true do + if Atomic.get signals_requested > !signals_sent then begin + Thread.delay signal_delay; + Unix.kill (Unix.getpid ()) Sys.sigint; + incr signals_sent + end else begin + Thread.yield () + end + done) () +let request_signal () = Atomic.incr signals_requested + +let () = + let (rd, wr) = Unix.pipe () in + Sys.catch_break true; + request_signal (); + begin match Unix.read rd (Bytes.make 1 'a') 0 1 with + | _ -> assert false + | exception Sys.Break -> print_endline "break: ok" end; + Sys.catch_break false; + Unix.close rd; + Unix.close wr + +let () = + let (rd, wr) = Unix.pipe () in + Sys.set_signal Sys.sigint (Signal_handle (fun _ -> Gc.full_major ())); + request_signal (); + begin match Unix.read rd (Bytes.make 1 'a') 0 1 with + | _ -> assert false + | exception Unix.Unix_error(Unix.EINTR, "read", _) -> + print_endline "eintr: ok" end; + Sys.set_signal Sys.sigint Signal_default; + Unix.close rd; + Unix.close wr + + +(* Doing I/O on stdout would be more realistic, but seeking has the + same locking & scheduling effects, without actually producing any + output *) +let poke_stdout () = + match out_channel_length stdout with + | _ -> () + | exception Sys_error _ -> () + +let () = + let r = Atomic.make true in + Sys.set_signal Sys.sigint (Signal_handle (fun _ -> + poke_stdout (); Atomic.set r false)); + request_signal (); + while Atomic.get r do + poke_stdout () + done; + Sys.set_signal Sys.sigint Signal_default; + print_endline "chan: ok" + +let () = + let mklist () = List.init 1000 (fun i -> (i, i)) in + let before = Sys.opaque_identity (ref (mklist ())) in + let during = Atomic.make (Sys.opaque_identity (mklist ())) in + let siglist = ref [] in + Sys.set_signal Sys.sigint (Signal_handle (fun _ -> + Gc.full_major (); poke_stdout (); Gc.compact (); + siglist := mklist (); + raise Sys.Break)); + request_signal (); + begin match + while true do + poke_stdout (); + Atomic.set during (mklist ()) + done + with + | () -> assert false + | exception Sys.Break -> () end; + let expected = Sys.opaque_identity (mklist ()) in + assert (!before = expected); + assert (Atomic.get during = expected); + assert (!siglist = expected); + print_endline "gc: ok" diff --git a/testsuite/tests/lib-systhreads/eintr.reference b/testsuite/tests/lib-systhreads/eintr.reference new file mode 100644 index 000000000..89355b9dd --- /dev/null +++ b/testsuite/tests/lib-systhreads/eintr.reference @@ -0,0 +1,4 @@ +break: ok +eintr: ok +chan: ok +gc: ok diff --git a/testsuite/tests/lib-unix/common/channel_of.ml b/testsuite/tests/lib-unix/common/channel_of.ml index f61dd9497..b0be29d06 100644 --- a/testsuite/tests/lib-unix/common/channel_of.ml +++ b/testsuite/tests/lib-unix/common/channel_of.ml @@ -22,7 +22,8 @@ let shouldfail msg fn arg = let _ = (* Files *) begin - let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in + let fd = Unix.(openfile "file.tmp" + [O_WRONLY;O_CREAT;O_TRUNC;O_SHARE_DELETE] 0o666) in shouldpass "File 1" Unix.in_channel_of_descr fd; shouldpass "File 2" Unix.out_channel_of_descr fd; Unix.close fd @@ -57,7 +58,8 @@ let _ = end; (* A closed file descriptor should now fail *) begin - let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in + let fd = Unix.(openfile "file.tmp" + [O_WRONLY;O_CREAT;O_TRUNC;O_SHARE_DELETE] 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 diff --git a/testsuite/tests/lib-unix/kill/unix_kill.ml b/testsuite/tests/lib-unix/kill/unix_kill.ml new file mode 100644 index 000000000..2ace3849c --- /dev/null +++ b/testsuite/tests/lib-unix/kill/unix_kill.ml @@ -0,0 +1,26 @@ +(* TEST +include unix +* libunix +** bytecode +** native +*) + +let () = + let r = ref false in + Sys.set_signal Sys.sigint (Signal_handle (fun _ -> r := true)); + Unix.kill (Unix.getpid ()) Sys.sigint; + let x = !r in + Printf.printf "%b " x; + Printf.printf "%b\n" !r + +let () = + let r = ref false in + let _ = Unix.sigprocmask SIG_BLOCK [Sys.sigint] in + Sys.set_signal Sys.sigint (Signal_handle (fun _ -> r := true)); + Unix.kill (Unix.getpid ()) Sys.sigint; + Gc.full_major (); + let a = !r in + let _ = Unix.sigprocmask SIG_UNBLOCK [Sys.sigint] in + let b = !r in + Printf.printf "%b %b " a b; + Printf.printf "%b\n" !r diff --git a/testsuite/tests/lib-unix/kill/unix_kill.reference b/testsuite/tests/lib-unix/kill/unix_kill.reference new file mode 100644 index 000000000..bb03effa9 --- /dev/null +++ b/testsuite/tests/lib-unix/kill/unix_kill.reference @@ -0,0 +1,2 @@ +true true +false true true diff --git a/testsuite/tests/misc/ephe_infix.ml b/testsuite/tests/misc/ephe_infix.ml new file mode 100644 index 000000000..3204d5be2 --- /dev/null +++ b/testsuite/tests/misc/ephe_infix.ml @@ -0,0 +1,26 @@ +(* TEST *) + +(* Testing handling of infix_tag by ephemeron *) + +let infix n = let rec f () = n and g () = f () in g + +(* Issue #9485 *) +let () = + let w = Weak.create 1 in + Weak.set w 0 (Some (infix 12)); + match Weak.get_copy w 0 with Some h -> ignore (h ()) | _ -> () + +(* Issue #7810 *) +let ephe x = + let open Ephemeron.K1 in + let e = create () in + set_key e x; + set_data e 42; + Gc.full_major (); + (x, get_data e) + +let () = + assert (ephe (ref 1000) = (ref 1000, Some 42)); + match ephe (infix 12) with + | (h, Some 42) -> () + | _ -> assert false diff --git a/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml index f46e57555..899504233 100644 --- a/testsuite/tests/parsetree/source.ml +++ b/testsuite/tests/parsetree/source.ml @@ -171,11 +171,14 @@ and[@foo] y = x type%foo[@foo] t = int and[@foo] t = int type%foo[@foo] t += T +type t += A = M.A[@a] +type t += B = M.A[@b] | C = M.A[@c][@@t] class%foo[@foo] x = x class type%foo[@foo] x = x external%foo[@foo] x : _ = "" exception%foo[@foo] X +exception A = M.A[@a] module%foo[@foo] M = M module%foo[@foo] rec M : S = M @@ -7380,3 +7383,9 @@ type t = unit let rec equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = (fun poly_a (_ : unit) (_ : unit) -> true) [@ocaml.warning "-A"] [@@ocaml.warning "-39"] + +(* Issue #9548, PR #9591 *) + +type u = [ `A ] ;; +type v = [ u | `B ] ;; +let f = fun (x : [ | u ]) -> x ;; diff --git a/testsuite/tests/tool-ocamltest/norm1.ml b/testsuite/tests/tool-ocamltest/norm1.ml new file mode 100644 index 000000000..ea32acffe --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm1.ml @@ -0,0 +1,5 @@ +(* TEST + *) +let () = set_binary_mode_out stdout true in +(* ocamltest must normalise the \r\n *) +print_string "line1\r\n"; flush stdout diff --git a/testsuite/tests/tool-ocamltest/norm1.reference b/testsuite/tests/tool-ocamltest/norm1.reference new file mode 100644 index 000000000..495181cc2 --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm1.reference @@ -0,0 +1 @@ +line1 diff --git a/testsuite/tests/tool-ocamltest/norm2.ml b/testsuite/tests/tool-ocamltest/norm2.ml new file mode 100644 index 000000000..284e99d69 --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm2.ml @@ -0,0 +1,5 @@ +(* TEST + *) +let () = set_binary_mode_out stdout true in +(* ocamltest must normalise the \r\n *) +print_string "line1\r\nline2\r\n"; flush stdout diff --git a/testsuite/tests/tool-ocamltest/norm2.reference b/testsuite/tests/tool-ocamltest/norm2.reference new file mode 100644 index 000000000..8561d5d6d --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm2.reference @@ -0,0 +1,2 @@ +line1 +line2 diff --git a/testsuite/tests/tool-ocamltest/norm3.ml b/testsuite/tests/tool-ocamltest/norm3.ml new file mode 100644 index 000000000..eb7baa75c --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm3.ml @@ -0,0 +1,5 @@ +(* TEST + *) +let () = set_binary_mode_out stdout true in +(* ocamltest must normalise the \r\n but preserve the final \r *) +print_string "line1\r\nline2\r"; flush stdout diff --git a/testsuite/tests/tool-ocamltest/norm3.reference b/testsuite/tests/tool-ocamltest/norm3.reference new file mode 100644 index 000000000..cad2bf9e4 --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm3.reference @@ -0,0 +1,2 @@ +line1 +line2 \ No newline at end of file diff --git a/testsuite/tests/tool-ocamltest/norm4.ml b/testsuite/tests/tool-ocamltest/norm4.ml new file mode 100644 index 000000000..7b06b9222 --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm4.ml @@ -0,0 +1,5 @@ +(* TEST + *) +let () = set_binary_mode_out stdout true in +(* ocamltest must normalise the \r\n *) +print_string "line1\r\nline2"; flush stdout diff --git a/testsuite/tests/tool-ocamltest/norm4.reference b/testsuite/tests/tool-ocamltest/norm4.reference new file mode 100644 index 000000000..3a1bd7a52 --- /dev/null +++ b/testsuite/tests/tool-ocamltest/norm4.reference @@ -0,0 +1,2 @@ +line1 +line2 \ No newline at end of file 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 index 255c4d10c..f4c3f497d 100644 --- a/testsuite/tests/tool-toplevel/known-bugs/broken_rec_in_show.ml +++ b/testsuite/tests/tool-toplevel/known-bugs/broken_rec_in_show.ml @@ -10,19 +10,19 @@ type t = T of t;; type t = T of t |}] #show t;; -(* this output is CORRECT, it does not use nonrec *) +(* this output is INCORRECT, it should not use nonrec *) [%%expect{| -type t = T of t +type nonrec t = T of t |}];; -type nonrec t = Foo of t;; +type nonrec s = Foo of t;; [%%expect{| -type nonrec t = Foo of t +type nonrec s = Foo of t |}];; -#show t;; -(* this output in INCORRECT, it should use nonrec *) +#show s;; +(* this output is CORRECT, it uses nonrec *) [%%expect{| -type t = Foo of t +type nonrec s = Foo of t |}];; diff --git a/testsuite/tests/tool-toplevel/pr6468.compilers.reference b/testsuite/tests/tool-toplevel/pr6468.compilers.reference index 6c2ab2ff2..55123b7c0 100644 --- a/testsuite/tests/tool-toplevel/pr6468.compilers.reference +++ b/testsuite/tests/tool-toplevel/pr6468.compilers.reference @@ -8,5 +8,7 @@ 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 +Called from Stdlib__fun.protect in file "fun.ml", line 33, characters 8-15 +Re-raised at Stdlib__fun.protect in file "fun.ml", line 38, characters 6-52 +Called from Toploop.load_lambda in file "toplevel/toploop.ml", line 212, characters 4-150 diff --git a/testsuite/tests/tool-toplevel/printval.ml b/testsuite/tests/tool-toplevel/printval.ml new file mode 100644 index 000000000..17c274444 --- /dev/null +++ b/testsuite/tests/tool-toplevel/printval.ml @@ -0,0 +1,60 @@ +(* TEST + * expect +*) + +(* Test a success case *) +type 'a t = T of 'a +;; +T 123 +[%%expect {| +type 'a t = T of 'a +- : int t = T 123 +|}] + +(* no after fix *) +type _ t = .. +type 'a t += T of 'a +;; +T 123 +[%%expect {| +type _ t = .. +type 'a t += T of 'a +- : int t = T 123 +|}] + + +(* GADT with fixed arg type *) +type _ t += T: char -> int t +;; +T 'x' +[%%expect {| +type _ t += T : char -> int t +- : int t = T 'x' +|}] + + +(* GADT with poly arg type.... and the expected T *) +type _ t += T: 'a -> int t +;; +T 'x' +[%%expect {| +type _ t += T : 'a -> int t +- : int t = T +|}] + +(* the rest are expected without *) +type _ t += T: 'a * bool -> 'a t +;; +T ('x',true) +[%%expect {| +type _ t += T : 'a * bool -> 'a t +- : char t = T ('x', true) +|}] + +type _ t += T: 'a -> ('a * bool) t +;; +T 'x' +[%%expect {| +type _ t += T : 'a -> ('a * bool) t +- : (char * bool) t = T 'x' +|}] diff --git a/testsuite/tests/tool-toplevel/show.ml b/testsuite/tests/tool-toplevel/show.ml index 9dd7dc664..6c000120e 100644 --- a/testsuite/tests/tool-toplevel/show.ml +++ b/testsuite/tests/tool-toplevel/show.ml @@ -40,7 +40,7 @@ type 'a option = None | Some of 'a #show option;; [%%expect {| -type 'a option = None | Some of 'a +type nonrec 'a option = None | Some of 'a |}];; #show Open_binary;; @@ -59,7 +59,7 @@ type Stdlib.open_flag = #show open_flag;; [%%expect {| -type open_flag = +type nonrec open_flag = Open_rdonly | Open_wronly | Open_append @@ -90,7 +90,7 @@ type extensible += B of int #show extensible;; [%%expect {| -type extensible = .. +type nonrec extensible = .. |}];; type 'a 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 000000000..c0c50de20 --- /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/translprim/comparison_table.compilers.reference b/testsuite/tests/translprim/comparison_table.compilers.reference index e518956cf..2ff6e7913 100644 --- a/testsuite/tests/translprim/comparison_table.compilers.reference +++ b/testsuite/tests/translprim/comparison_table.compilers.reference @@ -152,7 +152,7 @@ (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))) + (apply (field 18 (global Stdlib__list!)) (apply uncurry f) l))) (makeblock 0 (makeblock 0 (apply map gen_cmp vec) (apply map cmp vec)) (apply map @@ -190,7 +190,7 @@ (apply f (field 0 param) (field 1 param))) map = (function f l - (apply (field 16 (global Stdlib__list!)) + (apply (field 18 (global Stdlib__list!)) (apply uncurry f) l))) (makeblock 0 (makeblock 0 (apply map eta_gen_cmp vec) diff --git a/testsuite/tests/typing-gadts/pr9759.ml b/testsuite/tests/typing-gadts/pr9759.ml new file mode 100644 index 000000000..165eccdd8 --- /dev/null +++ b/testsuite/tests/typing-gadts/pr9759.ml @@ -0,0 +1,31 @@ +(* TEST + * expect +*) + +(* #9759 by Thomas Refis *) + +type 'a general = { indir: 'a desc; unit: unit } +and 'a desc = + | C : unit general -> unit desc ;; +[%%expect{| +type 'a general = { indir : 'a desc; unit : unit; } +and 'a desc = C : unit general -> unit desc +|}] + +let rec foo : type k . k general -> k general = fun g -> + match g.indir with + | C g' -> + let new_g' = foo g' in + if true then + {g with indir = C new_g'} + else + new_g' + | indir -> + {g with indir} ;; +[%%expect{| +Line 9, characters 4-9: +9 | | indir -> + ^^^^^ +Warning 11 [redundant-case]: this match case is unused. +val foo : 'k general -> 'k general = +|}] diff --git a/testsuite/tests/typing-misc/injectivity.ml b/testsuite/tests/typing-misc/injectivity.ml index 69bef6e13..bed73a1ca 100644 --- a/testsuite/tests/typing-misc/injectivity.ml +++ b/testsuite/tests/typing-misc/injectivity.ml @@ -330,7 +330,7 @@ type _ ty = let coe : type a b. (a,b) eq -> a ty -> b ty = fun Refl x -> x -let eq_int_any : type a. (int, a) eq = +let eq_int_any : type a. unit -> (int, a) eq = fun () -> let vec_ty : a Vec.t ty = coe Vec.eqt (Vec Int) in let Vec Int = vec_ty in Refl [%%expect{| @@ -343,7 +343,7 @@ Line 17, characters 2-30: Warning 8 [partial-match]: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Vec (Vec Int) -val eq_int_any : (int, 'a) eq = Refl +val eq_int_any : unit -> (int, 'a) eq = |}] (* Not directly related: injectivity and constraints *) diff --git a/testsuite/tests/typing-misc/labels.ml b/testsuite/tests/typing-misc/labels.ml index 3a00e3846..3b2d32b8e 100644 --- a/testsuite/tests/typing-misc/labels.ml +++ b/testsuite/tests/typing-misc/labels.ml @@ -90,3 +90,32 @@ Line 1, characters 45-46: Warning 19 [non-principal-labels]: 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-poly/poly.ml b/testsuite/tests/typing-poly/poly.ml index fc46d8d3b..9687949d4 100644 --- a/testsuite/tests/typing-poly/poly.ml +++ b/testsuite/tests/typing-poly/poly.ml @@ -1885,3 +1885,27 @@ Error: This expression has type < x : 'b. 'b s list > '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-shadowing-of-pervasives-submodules/redefine_largefile.ml b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml index 5d4ac6273..68401fa56 100644 --- a/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml +++ b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml @@ -1,4 +1,4 @@ (* TEST modules = "largeFile.ml" *) -print_string LargeFile.message +print_endline LargeFile.message diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml index 7cfa29028..aa2191445 100644 --- a/testsuite/tests/typing-sigsubst/sigsubst.ml +++ b/testsuite/tests/typing-sigsubst/sigsubst.ml @@ -24,11 +24,11 @@ end Line 3, characters 2-36: 3 | include Comparable with type t = t ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Illegal shadowing of included type t/98 by t/102 +Error: Illegal shadowing of included type t/99 by t/103 Line 2, characters 2-19: - Type t/98 came from this include + Type t/99 came from this include Line 3, characters 2-23: - The value print has no valid type if t/98 is shadowed + The value print has no valid type if t/99 is shadowed |}] module type Sunderscore = sig diff --git a/testsuite/tests/unwind/driver.ml b/testsuite/tests/unwind/driver.ml index 421f85a66..38fd7f064 100644 --- a/testsuite/tests/unwind/driver.ml +++ b/testsuite/tests/unwind/driver.ml @@ -4,17 +4,18 @@ 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 +** arch_amd64 +*** script +**** setup-ocamlopt.byte-build-env +***** ocamlopt.byte flags = "-opaque" module = "mylib.mli" -***** ocamlopt.byte +****** 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 +******* run *) diff --git a/testsuite/tests/unwind/stack_walker.c b/testsuite/tests/unwind/stack_walker.c index dd44d9848..342eb932f 100644 --- a/testsuite/tests/unwind/stack_walker.c +++ b/testsuite/tests/unwind/stack_walker.c @@ -65,6 +65,7 @@ value ml_perform_stack_walk() { printf("TEST FAILED\n"); /* Re-run the test to produce a trace */ perform_stack_walk(1); + exit(1); } return Val_unit; } diff --git a/testsuite/tests/warnings/w68.compilers.reference b/testsuite/tests/warnings/w68.compilers.reference new file mode 100644 index 000000000..198706c31 --- /dev/null +++ b/testsuite/tests/warnings/w68.compilers.reference @@ -0,0 +1,11 @@ +File "w68.ml", line 34, characters 33-43: +34 | let dont_warn_with_partial_match None x = x + ^^^^^^^^^^ +Warning 8 [partial-match]: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +Some _ +File "w68.ml", line 14, characters 10-13: +14 | let alloc {a} b = a + b + ^^^ +Warning 68 [match-on-mutable-state-prevent-uncurry]: This pattern depends on mutable state. +It prevents the remaining arguments from being uncurried, which will cause additional closure allocations. diff --git a/testsuite/tests/warnings/w68.ml b/testsuite/tests/warnings/w68.ml new file mode 100644 index 000000000..01b9c203f --- /dev/null +++ b/testsuite/tests/warnings/w68.ml @@ -0,0 +1,34 @@ +(* TEST + +flags = "-w A" + +* setup-ocamlopt.byte-build-env +** ocamlopt.byte +*** check-ocamlopt.byte-output +**** run +***** check-program-output +*) + +type a = { mutable a : int } + +let alloc {a} b = a + b + +let noalloc b {a} = b + a + +let measure name f = + let a = {a = 1} in + let b = 2 in + let before = Gc.minor_words () in + let (_ : int) = f ~a ~b in + let after = Gc.minor_words () in + let alloc = int_of_float (after -. before) in + match alloc with + | 0 -> Printf.printf "%S doesn't allocate\n" name + | _ -> Printf.printf "%S allocates\n" name + +let () = + measure "noalloc" (fun ~a ~b -> noalloc b a); + measure "alloc" (fun ~a ~b -> alloc a b) + + +let dont_warn_with_partial_match None x = x diff --git a/testsuite/tests/warnings/w68.reference b/testsuite/tests/warnings/w68.reference new file mode 100644 index 000000000..1e8a8cca4 --- /dev/null +++ b/testsuite/tests/warnings/w68.reference @@ -0,0 +1,2 @@ +"noalloc" doesn't allocate +"alloc" allocates diff --git a/testsuite/tools/asmgen_arm64.S b/testsuite/tools/asmgen_arm64.S index 4b803d20b..6a06f8d7e 100644 --- a/testsuite/tools/asmgen_arm64.S +++ b/testsuite/tools/asmgen_arm64.S @@ -13,9 +13,15 @@ /* */ /**************************************************************************/ - .globl call_gen_code +#if defined(SYS_macosx) +#define G(sym) _##sym +#else +#define G(sym) sym +#endif + + .globl G(call_gen_code) .align 2 -call_gen_code: +G(call_gen_code): /* Set up stack frame and save callee-save registers */ stp x29, x30, [sp, -160]! add x29, sp, #0 @@ -51,8 +57,10 @@ call_gen_code: .globl caml_c_call .align 2 -caml_c_call: +G(caml_c_call): br x15 +#if !defined(SYS_macosx) /* Mark stack as non-executable */ .section .note.GNU-stack,"",%progbits +#endif diff --git a/tools/ci/inria/README.md b/tools/ci/inria/README.md new file mode 100644 index 000000000..8ade11237 --- /dev/null +++ b/tools/ci/inria/README.md @@ -0,0 +1,13 @@ +This directory contains the configuration files of the Jenkins jobs +used to test OCaml on Inria's continuous integration infrastructure. + +Each subdirectory under `tools/ci/inria` corresponds to one CI job +and should contain at least a `Jenkinsfile` describing the pipeline +associated with this job(1). In addition, the job's directory can also +contain a `script` file specifying the commands used to actually execute +the job. Other files may be included as appropriate. + +(1) The Jenkinsfiles can follow either the declarative syntax documented +at https://www.jenkins.io/doc/book/pipeline/syntax, or the advanced +(scripted) one documented at +https://www.jenkins.io/doc/book/pipeline/jenkinsfile/#advanced-scripted-pipeline diff --git a/tools/ci/inria/Risc-V/Jenkinsfile b/tools/ci/inria/Risc-V/Jenkinsfile new file mode 100644 index 000000000..4221adc37 --- /dev/null +++ b/tools/ci/inria/Risc-V/Jenkinsfile @@ -0,0 +1,42 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Sebastien Hinderer, INRIA Paris */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Pipeline for the Risc-V job on Inria's CI */ + +pipeline { + agent { label 'olive' } + stages { + stage('Verifying that OCaml commpiles on a Risc-V virtual machine') { + steps { + sh 'ssh -p 10000 riscv@localhost GIT_COMMIT=${GIT_COMMIT} ' + + 'flambda=false /home/riscv/run-ci' + } + } + } + post { + regression { + emailext ( + to: 'ocaml-ci-notifications@inria.fr', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } +} diff --git a/tools/ci/inria/bootstrap/Jenkinsfile b/tools/ci/inria/bootstrap/Jenkinsfile new file mode 100644 index 000000000..4f1f5a98c --- /dev/null +++ b/tools/ci/inria/bootstrap/Jenkinsfile @@ -0,0 +1,43 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Sebastien Hinderer, INRIA Paris */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Pipeline for the bootstrap job on Inria's CI */ + +/* Make sure the OCaml compiler can still be bootstrapped */ + +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage('Verifying that the OCaml compiler can be bootstrapped') { + steps { + sh 'tools/ci/inria/bootstrap/script' + } + } + } + post { + regression { + emailext ( + to: 'ocaml-ci-notifications@inria.fr', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } +} diff --git a/tools/ci/inria/remove-sinh-primitive.patch b/tools/ci/inria/bootstrap/remove-sinh-primitive.patch similarity index 100% rename from tools/ci/inria/remove-sinh-primitive.patch rename to tools/ci/inria/bootstrap/remove-sinh-primitive.patch diff --git a/tools/ci/inria/bootstrap b/tools/ci/inria/bootstrap/script similarity index 99% rename from tools/ci/inria/bootstrap rename to tools/ci/inria/bootstrap/script index 382aa0388..2169fc75b 100755 --- a/tools/ci/inria/bootstrap +++ b/tools/ci/inria/bootstrap/script @@ -74,7 +74,7 @@ change_exe_magic_number() { remove_primitive() { echo Removing the \'sinh\' primitive - patch -p1 < tools/ci/inria/remove-sinh-primitive.patch + patch -p1 < tools/ci/inria/bootstrap/remove-sinh-primitive.patch } ######################################################################### diff --git a/tools/ci/inria/check-typo/Jenkinsfile b/tools/ci/inria/check-typo/Jenkinsfile new file mode 100644 index 000000000..5ad6c9b20 --- /dev/null +++ b/tools/ci/inria/check-typo/Jenkinsfile @@ -0,0 +1,47 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Sebastien Hinderer, INRIA Paris */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Pipeline for the check-typo job on Inria's CI */ + +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage('Checking code style') { + steps { + sh ''' + if [ ! -x tools/check-typo ] ; then + echo "tools/check-typo does not appear to be executable?"; >2; + exit 1; + fi + tools/check-typo + ''' + } + } + } + post { + regression { + emailext ( + to: 'ocaml-ci-notifications@inria.fr', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } +} diff --git a/tools/ci/inria/dune-build/Jenkinsfile b/tools/ci/inria/dune-build/Jenkinsfile new file mode 100644 index 000000000..a53a641b4 --- /dev/null +++ b/tools/ci/inria/dune-build/Jenkinsfile @@ -0,0 +1,41 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Sebastien Hinderer, INRIA Paris */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Pipeline for the dune-build job on Inria's CI */ + +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage('Building the OCaml compiler with Dune') { + steps { + sh 'tools/ci/inria/dune-build/script' + } + } + } + post { + regression { + emailext ( + to: 'Sebastien.Hinderer@inria.fr, thomas.refis@gmail.com', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } +} diff --git a/tools/ci/inria/dune-build b/tools/ci/inria/dune-build/script similarity index 100% rename from tools/ci/inria/dune-build rename to tools/ci/inria/dune-build/script diff --git a/tools/ci/inria/other-configs/Jenkinsfile b/tools/ci/inria/other-configs/Jenkinsfile new file mode 100644 index 000000000..75b8f6009 --- /dev/null +++ b/tools/ci/inria/other-configs/Jenkinsfile @@ -0,0 +1,43 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Sebastien Hinderer, INRIA Paris */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Pipeline for the other-configs job on Inria's CI */ + +/* Test various other compiler configurations */ + +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage('Testing various other compiler configurations') { + steps { + sh 'tools/ci/inria/other-configs/script' + } + } + } + post { + regression { + emailext ( + to: 'ocaml-ci-notifications@inria.fr', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } +} diff --git a/tools/ci/inria/other-configs b/tools/ci/inria/other-configs/script similarity index 100% rename from tools/ci/inria/other-configs rename to tools/ci/inria/other-configs/script diff --git a/otherlibs/win32unix/mkdir.c b/tools/ci/inria/sanitizers/Jenkinsfile similarity index 51% rename from otherlibs/win32unix/mkdir.c rename to tools/ci/inria/sanitizers/Jenkinsfile index 1b2a33a52..7add2f2f2 100644 --- a/otherlibs/win32unix/mkdir.c +++ b/tools/ci/inria/sanitizers/Jenkinsfile @@ -2,9 +2,9 @@ /* */ /* OCaml */ /* */ -/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */ +/* Sebastien Hinderer, INRIA Paris */ /* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* Copyright 2020 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ @@ -13,22 +13,29 @@ /* */ /**************************************************************************/ -#define CAML_INTERNALS +/* Pipeline for the sanitizers job on Inria's CI */ -#include -#include -#include -#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; +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage('Compiling and testing OCaml with sanitizers') { + steps { + sh 'tools/ci/inria/sanitizers/script' + } + } + } + post { + regression { + emailext ( + to: 'ocaml-ci-notifications@inria.fr', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } } diff --git a/tools/ci/inria/lsan-suppr.txt b/tools/ci/inria/sanitizers/lsan-suppr.txt similarity index 100% rename from tools/ci/inria/lsan-suppr.txt rename to tools/ci/inria/sanitizers/lsan-suppr.txt diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/sanitizers/script similarity index 57% rename from tools/ci/inria/extra-checks rename to tools/ci/inria/sanitizers/script index 641250392..5f8e5b6e7 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/sanitizers/script @@ -24,77 +24,17 @@ 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} -} +jobs=-j8 +make=make ######################################################################### + +# Print each command before its execution +set -x + # 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 @@ -106,7 +46,7 @@ else run_testsuite="$make -C testsuite all" fi -# A tool that make error backtrace nicer +# A tool that makes error backtraces 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 @@ -114,43 +54,11 @@ 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" --disable-dependency-generation - -# 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 --enable-dependency-generation # These are the undefined behaviors we want to check # Others occur on purpose e.g. signed arithmetic overflow @@ -168,20 +76,22 @@ shift-exponent,\ unreachable" # Select address sanitizer and UB sanitizer, with trap-on-error behavior +sanitizers="-fsanitize=address -fsanitize-trap=$ubsan" + # 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" + +./configure \ + CC=clang-9 \ + CFLAGS="-O1 -fno-omit-frame-pointer $sanitizers" \ + --disable-stdlib-manpages --enable-dependency-generation # 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 +LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/sanitizers/lsan-suppr.txt" \ +make $jobs # Run the testsuite. # We deactivate leak detection for two reasons: @@ -201,17 +111,16 @@ echo "======== clang 9, thread sanitizer ==========" git clean -q -f -d -x -./configure CC=clang-9 --disable-stdlib-manpages --enable-dependency-generation - # 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" + +./configure \ + CC=clang-9 \ + CFLAGS="-O1 -fno-omit-frame-pointer -fsanitize=thread" \ + --disable-stdlib-manpages --enable-dependency-generation # Build the system -make $jobs world.opt +make $jobs # Run the testsuite. # ThreadSanitizer complains about fork() in threaded programs, @@ -230,24 +139,19 @@ TSAN_OPTIONS="die_after_fork=0" $run_testsuite # 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 +# ./configure \ +# CC=clang-9 \ +# CFLAGS="-O0 -g -fno-omit-frame-pointer -fsanitize=memory" \ +# --disable-native-compiler +# # A tool that makes error backtraces 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 +# make $jobs # $run_testsuite diff --git a/tools/ci/inria/step-by-step-build/Jenkinsfile b/tools/ci/inria/step-by-step-build/Jenkinsfile new file mode 100644 index 000000000..eb020c656 --- /dev/null +++ b/tools/ci/inria/step-by-step-build/Jenkinsfile @@ -0,0 +1,45 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Sebastien Hinderer, INRIA Paris */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Pipeline for the step-by-step-build job on Inria's CI */ + +/* Build OCaml the legacy way (without using the world.opt target) */ + +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage( + 'Building the OCaml compiler step by step (without using world.opt)' + ) { + steps { + sh 'tools/ci/inria/step-by-step-build/script' + } + } + } + post { + regression { + emailext ( + to: 'ocaml-ci-notifications@inria.fr', + subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', + body: 'Changes since the last successful build:\n\n' + + '${CHANGES, format="%r %a %m"}\n\n' + + 'See the attached build log or check console output here:\n' + + '$BUILD_URL\n', + /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */ + attachLog: true + ) + } + } +} diff --git a/tools/ci/inria/step-by-step-build/script b/tools/ci/inria/step-by-step-build/script new file mode 100755 index 000000000..8397e6836 --- /dev/null +++ b/tools/ci/inria/step-by-step-build/script @@ -0,0 +1,25 @@ +#!/bin/sh +#************************************************************************** +#* * +#* OCaml * +#* * +#* Sebastien Hinderer projet Cambium, INRIA Paris * +#* * +#* 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. * +#* * +#************************************************************************** + +jobs=-j8 +instdir="$HOME/ocaml-tmp-install-$$" +./configure --prefix "$instdir" --disable-dependency-generation +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 diff --git a/toplevel/dune b/toplevel/dune index 476274b9a..d1a96d607 100644 --- a/toplevel/dune +++ b/toplevel/dune @@ -54,6 +54,7 @@ stdlib__Char stdlib__Complex stdlib__Digest + stdlib__Either stdlib__Ephemeron stdlib__Filename stdlib__Float diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml index 0cb0d6f1c..c08a71e4e 100644 --- a/toplevel/genprintval.ml +++ b/toplevel/genprintval.ml @@ -384,8 +384,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct 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) + (instantiate_type env decl.type_params ty_list body) | {type_kind = Type_variant constr_list; type_unboxed} -> let unbx = type_unboxed.unboxed in let tag = @@ -408,12 +407,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct 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 + instantiate_types env type_params ty_list l in tree_of_constr_with_args (tree_of_constr env path) (Ident.name cd_id) false 0 depth obj ty_args unbx @@ -444,7 +438,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct lbl_list pos obj unbx end | {type_kind = Type_open} -> - tree_of_extension path depth obj + tree_of_extension path ty_list depth obj with Not_found -> (* raised by Env.find_type *) Oval_stuff "" @@ -494,12 +488,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct 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 ty_arg = instantiate_type env type_params ty_list ld_type in let name = Ident.name ld_id in (* PR#5722: print full module path only for first record field *) @@ -544,7 +533,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct in Oval_constr (lid, args) - and tree_of_extension type_path depth bucket = + and tree_of_extension type_path ty_list depth bucket = let slot = if O.tag bucket <> 0 then bucket else O.field bucket 0 @@ -571,10 +560,17 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct identifier contained in the exception bucket *) if not (EVP.same_value slot (EVP.eval_address addr)) then raise Not_found; + let type_params = + match (Ctype.repr cstr.cstr_res).desc with + Tconstr (_,params,_) -> + params + | _ -> assert false + in + let args = instantiate_types env type_params ty_list cstr.cstr_args in tree_of_constr_with_args (fun x -> Oide_ident x) name (cstr.cstr_inlined <> None) 1 depth bucket - cstr.cstr_args false + args false with Not_found | EVP.Error -> match check_depth depth bucket ty with Some x -> x @@ -583,6 +579,13 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct | None -> Oval_stuff "" + and instantiate_type env type_params ty_list ty = + try Ctype.apply env type_params ty ty_list + with Ctype.Cannot_apply -> abstract_type + + and instantiate_types env type_params ty_list args = + List.map (instantiate_type env type_params ty_list) args + and find_printer depth env ty = let rec find = function | [] -> raise Not_found diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 20e6912ae..530a927f8 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -556,7 +556,7 @@ 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_first, Exported) ] + [ Sig_type (id, desc, Trec_not, Exported) ] ) "Print the signature of the corresponding type constructor." diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index f2b3845a7..5e5fc436d 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -207,15 +207,15 @@ let load_lambda ppf lam = Symtable.update_global_table(); let initial_bindings = !toplevel_value_bindings in let bytecode, closure = Meta.reify_bytecode code [| events |] None in - try + match 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; + Fun.protect + ~finally:(fun () -> may_trace := false; + if can_free then Meta.release_bytecode bytecode) + closure + with + | retval -> Result retval + | exception x -> record_backtrace (); toplevel_value_bindings := initial_bindings; (* PR#6211 *) Symtable.restore_state initial_symtable; diff --git a/typing/ctype.ml b/typing/ctype.ml index eb8011b76..5b1c25979 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -4055,8 +4055,7 @@ let rec build_subtype env visited loops posi level t = (t, Unchanged) else (t, Unchanged) - | Tarrow(l, t1, t2, com) -> - assert (com = Cok); + | 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 diff --git a/typing/printtyp.ml b/typing/printtyp.ml index cfb5015de..fe30b3f36 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -490,8 +490,8 @@ 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 + fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;desc=@,%a}@]" ty.id ty.level + ty.scope raw_type_desc ty.desc end and raw_type_list tl = raw_list raw_type tl and raw_type_desc ppf = function @@ -591,11 +591,25 @@ let apply_subst s1 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) +(** Short-paths cache: the five mutable variables below implement a one-slot + cache for short-paths + *) let printing_old = ref Env.empty let printing_pers = ref Concr.empty +(** {!printing_old} and {!printing_pers} are the keys of the one-slot cache *) + +let printing_depth = ref 0 +let printing_cont = ref ([] : Env.iter_cont list) let printing_map = ref Path.Map.empty +(** + - {!printing_map} is the main value stored in the cache. + Note that it is evaluated lazily and its value is updated during printing. + - {!printing_dep} is the current exploration depth of the environment, + it is used to determine whenever the {!printing_map} should be evaluated + further before completing a request. + - {!printing_cont} is the list of continuations needed to evaluate + the {!printing_map} one level further (see also {!Env.run_iter_cont}) +*) let same_type t t' = repr t == repr t' @@ -1583,9 +1597,28 @@ let cltype_declaration id ppf cl = (* Print a module type *) let wrap_env fenv ftree arg = + (* We save the current value of the short-path cache *) + (* From keys *) let env = !printing_env in + let old_pers = !printing_pers in + (* to data *) + let old_map = !printing_map in + let old_depth = !printing_depth in + let old_cont = !printing_cont in set_printing_env (fenv env); let tree = ftree arg in + if !Clflags.real_paths + || same_printing_env env then () + (* our cached key is still live in the cache, and we want to keep all + progress made on the computation of the [printing_map] *) + else begin + (* we restore the snapshotted cache before calling set_printing_env *) + printing_old := env; + printing_pers := old_pers; + printing_depth := old_depth; + printing_cont := old_cont; + printing_map := old_map + end; set_printing_env env; tree diff --git a/typing/typecore.ml b/typing/typecore.ml index a49f53d5d..22eb7ee31 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1442,9 +1442,9 @@ and type_pat_aux begin match ty.desc with | Tpoly (body, tyl) -> begin_def (); + init_def generic_level; 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); @@ -1500,10 +1500,7 @@ and type_pat_aux 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; + let expected_ty = generic_instance expected_ty in 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 { @@ -1644,10 +1641,7 @@ and type_pat_aux 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; + let expected_ty = generic_instance expected_ty in (* PR#7404: allow some_private_tag blindly, as it would not unify with the abstract row variable *) if l = Parmatch.some_private_tag @@ -1671,10 +1665,7 @@ and type_pat_aux 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; + let ty = generic_instance expected_ty in let principal = (repr expected_ty).level = generic_level || not !Clflags.principal in @@ -1720,10 +1711,7 @@ and type_pat_aux end | Ppat_array spl -> let ty_elt = newgenvar() in - begin_def (); - let expected_ty = instance expected_ty in - end_def (); - generalize_structure expected_ty; + let expected_ty = generic_instance expected_ty in 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 -> @@ -1813,7 +1801,8 @@ and type_pat_aux end | Ppat_lazy sp1 -> let nv = newgenvar () in - unify_pat_types ~refine loc env (Predef.type_lazy_t nv) expected_ty; + unify_pat_types ~refine loc env (Predef.type_lazy_t nv) + (generic_instance expected_ty); (* do not explode under lazy: PR#7421 *) type_pat Value ~mode:(no_explosion mode) sp1 nv (fun p1 -> rvp k { @@ -2815,7 +2804,7 @@ and type_expect_ 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); + unify_exp_types loc env to_unify (generic_instance ty_expected)); let expl = List.map2 (fun body ty -> type_expect env body (mk_expected ty)) sexpl subtypes @@ -2918,7 +2907,7 @@ and type_expect_ (fun x -> x) in with_explanation (fun () -> - unify_exp_types loc env ty_record (instance ty_expected)); + unify_exp_types loc env (instance 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 @@ -3034,7 +3023,7 @@ and type_expect_ let ty = newgenvar() in let to_unify = Predef.type_array ty in with_explanation (fun () -> - unify_exp_types loc env to_unify ty_expected); + unify_exp_types loc env to_unify (generic_instance ty_expected)); let argl = List.map (fun sarg -> type_expect env sarg (mk_expected ty)) sargl in re { @@ -3478,7 +3467,7 @@ and type_expect_ 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); + unify_exp_types loc env to_unify (generic_instance ty_expected)); let arg = type_expect env e (mk_expected ty) in re { exp_desc = Texp_lazy arg; @@ -4727,14 +4716,9 @@ and type_cases 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]... *) + (* allow propagation from preceding branches *) 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 @@ -5041,7 +5025,9 @@ and type_let so we do it anyway. *) generalize exp.exp_type | Some vars -> - generalize_and_check_univars env "definition" exp pat.pat_type 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 = diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 52fdca513..ae25fc6b6 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -1434,7 +1434,7 @@ let transl_with_constraint id row_path ~sig_env ~sig_decl ~outer_env sdecl = 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 + (* Note: constraints 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 diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 786089465..84c5de3d5 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -685,7 +685,7 @@ let transl_simple_type_delayed env styp = end_def (); make_fixed_univars typ.ctyp_type; (* This brings the used variables to the global level, but doesn't link them - to their other occurences just yet. This will be done when [force] is + to their other occurrences just yet. This will be done when [force] is called. *) let force = globalize_used_variables env false in (* Generalizes everything except the variables that were just globalized. *) diff --git a/utils/warnings.ml b/utils/warnings.ml index 21d29d0bc..8dd59730f 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -92,6 +92,7 @@ type t = | Redefining_unit of string (* 65 *) | Unused_open_bang of string (* 66 *) | Unused_functor_parameter of string (* 67 *) + | Match_on_mutable_state_prevent_uncurry (* 68 *) ;; (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -169,9 +170,10 @@ let number = function | Redefining_unit _ -> 65 | Unused_open_bang _ -> 66 | Unused_functor_parameter _ -> 67 + | Match_on_mutable_state_prevent_uncurry -> 68 ;; -let last_warning_number = 67 +let last_warning_number = 68 ;; (* Third component of each tuple is the list of names for each warning. The @@ -327,6 +329,9 @@ let descriptions = ["unused-open-bang"]; 67, "Unused functor parameter.", ["unused-functor-parameter"]; + 68, "Pattern-matching depending on mutable state prevents the remaining \ + arguments from being uncurried.", + ["match-on-mutable-state-prevent-uncurry"]; ] ;; @@ -567,7 +572,7 @@ let parse_options 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_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67-68";; let defaults_warn_error = "-a+31";; let () = parse_options false defaults_w;; @@ -805,6 +810,10 @@ let message = function which shadows the existing one.\n\ Hint: Did you mean 'type %s = unit'?" name | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "." + | Match_on_mutable_state_prevent_uncurry -> + "This pattern depends on mutable state.\n\ + It prevents the remaining arguments from being uncurried, which will \ + cause additional closure allocations." ;; let nerrors = ref 0;; diff --git a/utils/warnings.mli b/utils/warnings.mli index 82e8b613b..0bf8028bf 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -94,6 +94,7 @@ type t = | Redefining_unit of string (* 65 *) | Unused_open_bang of string (* 66 *) | Unused_functor_parameter of string (* 67 *) + | Match_on_mutable_state_prevent_uncurry (* 68 *) ;; type alert = {kind:string; message:string; def:loc; use:loc}