From 7dd55f8cddf26d07e4617136cd4aa188ed1d4eb4 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 25 Sep 2019 20:09:36 +0100 Subject: [PATCH 001/160] Fix redefine_largefile.ml test The reference file included EOL at EOF but the test didn't produce one. --- .../redefine_largefile.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 95400d7ee04126abc0a1dba5db3f1cecf435e9ba Mon Sep 17 00:00:00 2001 From: Jacques-Henri Jourdan Date: Mon, 6 Jul 2020 18:23:07 +0200 Subject: [PATCH 002/160] Make Ephemeron compatible with infix pointers. --- Changes | 4 ++++ runtime/caml/weak.h | 1 + runtime/minor_gc.c | 33 +++++++++++++++++------------ runtime/weak.c | 34 ++++++++++++++++++++---------- testsuite/tests/misc/ephe_infix.ml | 26 +++++++++++++++++++++++ 5 files changed, 74 insertions(+), 24 deletions(-) create mode 100644 testsuite/tests/misc/ephe_infix.ml diff --git a/Changes b/Changes index db5461683..6dfbab855 100644 --- a/Changes +++ b/Changes @@ -90,6 +90,10 @@ 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 occuring + when using mutually recursive functions. + (Jacques-Henri Jourdan, review François Bobot) + ### Code generation and optimizations: - #9551: ocamlc no longer loads DLLs at link time to check that diff --git a/runtime/caml/weak.h b/runtime/caml/weak.h index df35fac96..a98915414 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; diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index b8661bc7e..b6b08a1e4 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; 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/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 From 6ad48f8229b6331b8282b99d59f1c5e157e79494 Mon Sep 17 00:00:00 2001 From: Jacques-Henri Jourdan Date: Sat, 18 Jul 2020 08:24:12 +0200 Subject: [PATCH 003/160] Fix assertion in weak.h when data fild is an infix pointer. --- runtime/caml/weak.h | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/runtime/caml/weak.h b/runtime/caml/weak.h index a98915414..8192496f0 100644 --- a/runtime/caml/weak.h +++ b/runtime/caml/weak.h @@ -201,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 } } From 9a7a17c01247be5ee7f9445d3addbe293aaa1509 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 21 Jul 2020 14:15:40 +0100 Subject: [PATCH 004/160] Add Sys.mkdir --- .gitignore | 1 + Changes | 4 ++++ otherlibs/unix/mkdir.c | 12 +++++++++--- otherlibs/win32unix/Makefile | 4 ++-- otherlibs/win32unix/mkdir.c | 34 ---------------------------------- runtime/caml/misc.h | 2 ++ runtime/sys.c | 15 +++++++++++++++ stdlib/sys.mli | 6 ++++++ stdlib/sys.mlp | 1 + 9 files changed, 40 insertions(+), 39 deletions(-) delete mode 100644 otherlibs/win32unix/mkdir.c diff --git a/.gitignore b/.gitignore index afac70dab..0ffedcf24 100644 --- a/.gitignore +++ b/.gitignore @@ -163,6 +163,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 fa081b4f0..d4dfe705a 100644 --- a/Changes +++ b/Changes @@ -178,6 +178,10 @@ Working version 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. + (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; 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/win32unix/Makefile b/otherlibs/win32unix/Makefile index 16e59372c..769e840e2 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/mkdir.c b/otherlibs/win32unix/mkdir.c deleted file mode 100644 index 1b2a33a52..000000000 --- a/otherlibs/win32unix/mkdir.c +++ /dev/null @@ -1,34 +0,0 @@ -/**************************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/**************************************************************************/ - -#define CAML_INTERNALS - -#include -#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; -} 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/sys.c b/runtime/sys.c index b401d47e1..5613f35b0 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -319,6 +319,21 @@ 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_getcwd(value unit) { char_os buff[4096]; diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 368baa0f6..a537c2251 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -94,6 +94,12 @@ 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 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..ba5ab434f 100644 --- a/stdlib/sys.mlp +++ b/stdlib/sys.mlp @@ -66,6 +66,7 @@ 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 getcwd: unit -> string = "caml_sys_getcwd" external readdir : string -> string array = "caml_sys_read_directory" From 99f56de82dc5602214568121e0b42787e199d6f5 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 21 Jul 2020 14:27:52 +0100 Subject: [PATCH 005/160] Use Sys.mkdir in ocamltest instead of shell call --- ocamltest/ocamltest_stdlib.ml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index 15b4963a8..1b8dd8abd 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -93,13 +93,17 @@ module Sys = struct command exitcode; exit 3 - let mkdir dir = - if not (Sys.file_exists dir) then - run_system_command "mkdir" [dir] - 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 From 496cc8b3a134b140ee0f5ec7ff5db58faa09a7df Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 21 Jul 2020 14:33:08 +0100 Subject: [PATCH 006/160] Remove incorrect stub in ocamltest_stdlib_stubs.c Miscopied from win32unix. --- ocamltest/ocamltest_stdlib_stubs.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/ocamltest/ocamltest_stdlib_stubs.c b/ocamltest/ocamltest_stdlib_stubs.c index d4d31a282..405c8247d 100644 --- a/ocamltest/ocamltest_stdlib_stubs.c +++ b/ocamltest/ocamltest_stdlib_stubs.c @@ -140,9 +140,6 @@ CAMLprim value caml_has_symlink(value unit) #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(); From f341db8dbe014029f9e199785363bf0af9711de5 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 21 Jul 2020 15:36:43 +0100 Subject: [PATCH 007/160] Add Sys.rmdir --- Changes | 2 +- runtime/sys.c | 15 +++++++++++++++ stdlib/sys.mli | 6 ++++++ stdlib/sys.mlp | 1 + 4 files changed, 23 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index d4dfe705a..4e0db184f 100644 --- a/Changes +++ b/Changes @@ -178,7 +178,7 @@ Working version 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. +- #9797: Add Sys.mkdir and Sys.rmdir. (David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and Xavier Leroy) diff --git a/runtime/sys.c b/runtime/sys.c index 5613f35b0..a131bcc17 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -334,6 +334,21 @@ CAMLprim value caml_sys_mkdir(value path, value perm) 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]; diff --git a/stdlib/sys.mli b/stdlib/sys.mli index a537c2251..cbe8e46fc 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -100,6 +100,12 @@ external mkdir : string -> int -> unit = "caml_sys_mkdir" @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 ba5ab434f..03ffc5151 100644 --- a/stdlib/sys.mlp +++ b/stdlib/sys.mlp @@ -67,6 +67,7 @@ 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" From 9bc33d945a66bdaaf4124acf70a19761a8e43e92 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 23 Jul 2020 14:55:36 +0100 Subject: [PATCH 008/160] Add Ocamltest_stdlib.Unix.has_symlink Replaces the duplicated C stub. Functions from Unix must be explictly imported. --- .gitignore | 1 + Makefile | 2 +- ocamltest/.depend | 10 +- ocamltest/Makefile | 40 +++++--- ocamltest/builtin_actions.ml | 2 +- ocamltest/ocamltest_stdlib.ml | 4 +- ocamltest/ocamltest_stdlib.mli | 5 +- ocamltest/ocamltest_stdlib_stubs.c | 151 ----------------------------- ocamltest/ocamltest_unix.mli | 18 ++++ ocamltest/ocamltest_unix_dummy.ml | 16 +++ ocamltest/ocamltest_unix_real.ml | 17 ++++ 11 files changed, 97 insertions(+), 169 deletions(-) delete mode 100644 ocamltest/ocamltest_stdlib_stubs.c create mode 100644 ocamltest/ocamltest_unix.mli create mode 100644 ocamltest/ocamltest_unix_dummy.ml create mode 100644 ocamltest/ocamltest_unix_real.ml diff --git a/.gitignore b/.gitignore index 0ffedcf24..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 diff --git a/Makefile b/Makefile index 5834f965d..aa7634bd9 100644 --- a/Makefile +++ b/Makefile @@ -867,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 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 c803bb7ae..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) \ 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/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index 1b8dd8abd..a95dd3dc5 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -15,6 +15,8 @@ (* A few extensions to OCaml's standard library *) +module Unix = Ocamltest_unix + (* Pervaisive *) let input_line_opt ic = @@ -165,8 +167,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; diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index 3a75aa21d..8ab88d663 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -54,10 +54,13 @@ module Sys : sig 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 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 405c8247d..000000000 --- a/ocamltest/ocamltest_stdlib_stubs.c +++ /dev/null @@ -1,151 +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 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..ed952213f --- /dev/null +++ b/ocamltest/ocamltest_unix.mli @@ -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. *) +(* *) +(**************************************************************************) + +(** 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 diff --git a/ocamltest/ocamltest_unix_dummy.ml b/ocamltest/ocamltest_unix_dummy.ml new file mode 100644 index 000000000..1a079cf7b --- /dev/null +++ b/ocamltest/ocamltest_unix_dummy.ml @@ -0,0 +1,16 @@ +(**************************************************************************) +(* *) +(* 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 diff --git a/ocamltest/ocamltest_unix_real.ml b/ocamltest/ocamltest_unix_real.ml new file mode 100644 index 000000000..68cfbb2e0 --- /dev/null +++ b/ocamltest/ocamltest_unix_real.ml @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* It's tempting just to have include Unix, but the binary is then quite a bit + bigger. *) +let has_symlink = Unix.has_symlink From fc0abfaad82aba1556a5a80d543cc0678a1ceb43 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 23 Jul 2020 15:04:49 +0100 Subject: [PATCH 009/160] Remove use of rm -rf from ocamltest --- ocamltest/main.ml | 6 +++--- ocamltest/ocamltest_stdlib.ml | 19 +++++++++++++++++++ ocamltest/ocamltest_stdlib.mli | 1 + ocamltest/ocamltest_unix.mli | 1 + ocamltest/ocamltest_unix_dummy.ml | 1 + ocamltest/ocamltest_unix_real.ml | 15 +++++++++++++-- 6 files changed, 38 insertions(+), 5 deletions(-) diff --git a/ocamltest/main.ml b/ocamltest/main.ml index 12b0c06c0..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; diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index a95dd3dc5..07d69889a 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -86,6 +86,25 @@ end module Sys = struct include Sys + 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 rm_rf path = + let rec erase path = + if Sys.is_directory path + then Array.iter (fun entry -> erase (Filename.concat path entry)) + (Sys.readdir path) + 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 run_system_command prog args = let command = Filename.quote_command prog args in match Sys.command command with diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index 8ab88d663..d19147f9b 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -48,6 +48,7 @@ module Sys : sig 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 diff --git a/ocamltest/ocamltest_unix.mli b/ocamltest/ocamltest_unix.mli index ed952213f..38d1883eb 100644 --- a/ocamltest/ocamltest_unix.mli +++ b/ocamltest/ocamltest_unix.mli @@ -16,3 +16,4 @@ temptation to use the Unix module directly in ocamltest. *) val has_symlink : unit -> bool +val chmod : string -> int -> unit diff --git a/ocamltest/ocamltest_unix_dummy.ml b/ocamltest/ocamltest_unix_dummy.ml index 1a079cf7b..207cc716d 100644 --- a/ocamltest/ocamltest_unix_dummy.ml +++ b/ocamltest/ocamltest_unix_dummy.ml @@ -14,3 +14,4 @@ (* Dummy implementations for when the Unix library isn't built *) let has_symlink () = false +let chmod _ _ = invalid_arg "chmod not available" diff --git a/ocamltest/ocamltest_unix_real.ml b/ocamltest/ocamltest_unix_real.ml index 68cfbb2e0..2a63e8bbb 100644 --- a/ocamltest/ocamltest_unix_real.ml +++ b/ocamltest/ocamltest_unix_real.ml @@ -12,6 +12,17 @@ (* *) (**************************************************************************) -(* It's tempting just to have include Unix, but the binary is then quite a bit - bigger. *) +(* 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 chmod file = wrap (Unix.chmod file) From 8b80c57fb2f9a8bf6c9ecf60881fadd3f1419403 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 23 Jul 2020 15:05:00 +0100 Subject: [PATCH 010/160] Remove use of ln -sf from ocamltest Implemented ln -sfT exactly on Unix and almost exactly on Windows. --- Changes | 6 ++++++ ocamltest/actions_helpers.ml | 16 ++++++++++++++-- ocamltest/ocamltest_stdlib.ml | 9 --------- ocamltest/ocamltest_stdlib.mli | 1 - ocamltest/ocamltest_unix.mli | 1 + ocamltest/ocamltest_unix_dummy.ml | 1 + ocamltest/ocamltest_unix_real.ml | 1 + 7 files changed, 23 insertions(+), 12 deletions(-) diff --git a/Changes b/Changes index 4e0db184f..52861c1ab 100644 --- a/Changes +++ b/Changes @@ -303,6 +303,12 @@ Working version attributes are present. (Matthew Ryan, review by Nicolás Ojeda Bär) +- #9797: 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) + ### Build system: - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For 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/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index 07d69889a..cad1d60d2 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -105,15 +105,6 @@ module Sys = struct with Sys_error err -> raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err)) - 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 rec make_directory dir = if Sys.file_exists dir then () else let () = make_directory (Filename.dirname dir) in diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index d19147f9b..f6605b6cf 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -46,7 +46,6 @@ 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 diff --git a/ocamltest/ocamltest_unix.mli b/ocamltest/ocamltest_unix.mli index 38d1883eb..1a111fd9d 100644 --- a/ocamltest/ocamltest_unix.mli +++ b/ocamltest/ocamltest_unix.mli @@ -16,4 +16,5 @@ 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 index 207cc716d..32b805992 100644 --- a/ocamltest/ocamltest_unix_dummy.ml +++ b/ocamltest/ocamltest_unix_dummy.ml @@ -14,4 +14,5 @@ (* 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 index 2a63e8bbb..322b911f9 100644 --- a/ocamltest/ocamltest_unix_real.ml +++ b/ocamltest/ocamltest_unix_real.ml @@ -25,4 +25,5 @@ let wrap f x = in raise (Sys_error msg) +let symlink ?to_dir source = wrap (Unix.symlink ?to_dir source) let chmod file = wrap (Unix.chmod file) From b9a4de7b2d94362b73d64bd1f625f2ebdc4224b7 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 23 Jul 2020 15:06:52 +0100 Subject: [PATCH 011/160] Eliminate typo --- ocamltest/ocamltest_stdlib.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index cad1d60d2..a18285984 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -17,8 +17,6 @@ module Unix = Ocamltest_unix -(* Pervaisive *) - let input_line_opt ic = try Some (input_line ic) with End_of_file -> None From 4375fa82db0eb3864d7ac7f59cb4de5216105618 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 12:47:22 -0300 Subject: [PATCH 012/160] arm64 runtime: use x17 instead of x18(reserved) --- runtime/arm64.S | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index 6bad4ce87..55a43b0f3 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -26,8 +26,7 @@ #define ALLOC_LIMIT x28 #define ARG x15 #define TMP x16 -#define TMP2 x17 -#define ARG_DOMAIN_STATE_PTR x18 +#define ARG_DOMAIN_STATE_PTR x17 #define C_ARG_1 x0 #define C_ARG_2 x1 @@ -62,8 +61,8 @@ #if defined(__PIC__) #define ADDRGLOBAL(reg,symb) \ - adrp TMP2, :got:symb; \ - ldr reg, [TMP2, #:got_lo12:symb] + adrp TMP, :got:symb; \ + ldr reg, [TMP, #:got_lo12:symb] #else #define ADDRGLOBAL(reg,symb) \ From bc1a664065feabb07a1ba73cc9fb37c8e714dd5e Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 21 Jun 2020 19:08:24 -0300 Subject: [PATCH 013/160] fix build when using clang This is flagged (rightly so) by clang -Wimplicit-int-float-conversion. --- runtime/memprof.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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; } From 32ab52c59a202f6661d9033c15358eda28ef4ad5 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 13:24:55 -0300 Subject: [PATCH 014/160] arm64 runtime: macro pair for functions --- runtime/arm64.S | 46 ++++++++++++++++++++-------------------------- 1 file changed, 20 insertions(+), 26 deletions(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index 55a43b0f3..cb1cfb1c6 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -89,10 +89,12 @@ caml_hot__code_end: #define FUNCTION(name) \ TEXT_SECTION(caml.##name); \ - .align 2; \ - .globl name; \ - .type name, %function; \ + .align 2; \ + .globl name; \ + .type name, %function; \ name: +#define END_FUNCTION(name) \ + .size name, .-name /* Allocation functions and GC interface */ .globl caml_system__code_begin @@ -182,7 +184,7 @@ 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 @@ -191,7 +193,7 @@ FUNCTION(caml_alloc1) b.lo .Lcaml_call_gc ret CFI_ENDPROC - .size caml_alloc1, .-caml_alloc1 + END_FUNCTION(caml_alloc1) FUNCTION(caml_alloc2) CFI_STARTPROC @@ -200,7 +202,7 @@ FUNCTION(caml_alloc2) b.lo .Lcaml_call_gc ret CFI_ENDPROC - .size caml_alloc2, .-caml_alloc2 + END_FUNCTION(caml_alloc2) FUNCTION(caml_alloc3) CFI_STARTPROC @@ -209,7 +211,7 @@ FUNCTION(caml_alloc3) b.lo .Lcaml_call_gc ret CFI_ENDPROC - .size caml_alloc3, .-caml_alloc3 + END_FUNCTION(caml_alloc3) FUNCTION(caml_allocN) CFI_STARTPROC @@ -218,7 +220,7 @@ FUNCTION(caml_allocN) b.lo .Lcaml_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 */ @@ -243,7 +245,7 @@ FUNCTION(caml_c_call) /* Return */ ret x19 CFI_ENDPROC - .size caml_c_call, .-caml_c_call + END_FUNCTION(caml_c_call) /* Start the OCaml program */ @@ -324,7 +326,7 @@ FUNCTION(caml_start_program) 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 */ @@ -366,7 +368,7 @@ FUNCTION(caml_raise_exn) mov x0, x19 b 1b CFI_ENDPROC - .size caml_raise_exn, .-caml_raise_exn + END_FUNCTION(caml_raise_exn) /* Raise an exception from C */ @@ -401,7 +403,7 @@ FUNCTION(caml_raise_exception) mov x0, x19 b 1b CFI_ENDPROC - .size caml_raise_exception, .-caml_raise_exception + END_FUNCTION(caml_raise_exception) /* Callback from C to OCaml */ @@ -415,13 +417,9 @@ FUNCTION(caml_callback_asm) ldr ARG, [x1] /* code pointer */ b .Ljump_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) */ @@ -432,13 +430,9 @@ caml_callback2_asm: ADDRGLOBAL(ARG, caml_apply2) b .Ljump_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, @@ -450,7 +444,7 @@ caml_callback3_asm: ADDRGLOBAL(ARG, caml_apply3) b .Ljump_to_caml CFI_ENDPROC - .size caml_callback3_asm, .-caml_callback3_asm + END_FUNCTION(caml_callback3_asm) FUNCTION(caml_ml_array_bound_error) CFI_STARTPROC @@ -459,7 +453,7 @@ FUNCTION(caml_ml_array_bound_error) /* Call that function */ b 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: From f6c799d08fb4e322c2a8b78bdfbca0e165c55473 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 13:30:53 -0300 Subject: [PATCH 015/160] arm64 runtime: macro pair for objects --- runtime/arm64.S | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index cb1cfb1c6..d094af4a3 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -96,6 +96,15 @@ name: #define END_FUNCTION(name) \ .size name, .-name +#define OBJECT(name) \ + .data; \ + .align 3; \ + .globl name; \ + .type name, %object; \ +name: +#define END_OBJECT(name) \ + .size name, .-name + /* Allocation functions and GC interface */ .globl caml_system__code_begin caml_system__code_begin: @@ -460,17 +469,13 @@ 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 */ .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) /* Mark stack as non-executable */ .section .note.GNU-stack,"",%progbits From cbcd76b4c84242138697f01884073dd982893aa0 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 13:37:26 -0300 Subject: [PATCH 016/160] arm64 runtime: remove .type, .size on local labels --- runtime/arm64.S | 4 ---- 1 file changed, 4 deletions(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index d094af4a3..13b7ebfa8 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -333,8 +333,6 @@ FUNCTION(caml_start_program) /* Return to C caller */ ret CFI_ENDPROC - .type .Lcaml_retaddr, %function - .size .Lcaml_retaddr, .-.Lcaml_retaddr END_FUNCTION(caml_start_program) /* The trap handler */ @@ -349,8 +347,6 @@ FUNCTION(caml_start_program) /* Return it */ b .Lreturn_result CFI_ENDPROC - .type .Ltrap_handler, %function - .size .Ltrap_handler, .-.Ltrap_handler /* Raise an exception from OCaml */ From 42943915a764688aac26573cc0a3e2a10797259e Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 13:58:59 -0300 Subject: [PATCH 017/160] arm64 runtime: macro for global and local symbols --- runtime/arm64.S | 81 ++++++++++++++++++---------------- testsuite/tools/asmgen_arm64.S | 8 ++-- 2 files changed, 47 insertions(+), 42 deletions(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index 13b7ebfa8..0d2bd26c6 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -58,16 +58,19 @@ #define Caml_state(var) [x25, 8*domain_field_caml_##var] +#define G(sym) sym +#define L(lbl) .L##lbl + #if defined(__PIC__) #define ADDRGLOBAL(reg,symb) \ - adrp TMP, :got:symb; \ - ldr reg, [TMP, #:got_lo12:symb] + adrp TMP, :got:G(symb); \ + ldr reg, [TMP, #: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 @@ -79,39 +82,39 @@ #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 #define FUNCTION(name) \ TEXT_SECTION(caml.##name); \ .align 2; \ - .globl name; \ - .type name, %function; \ -name: + .globl G(name); \ + .type G(name), %function; \ +G(name): #define END_FUNCTION(name) \ - .size name, .-name + .size G(name), .-G(name) #define OBJECT(name) \ .data; \ .align 3; \ - .globl name; \ - .type name, %object; \ -name: + .globl G(name); \ + .type G(name), %object; \ +G(name): #define END_OBJECT(name) \ - .size name, .-name + .size G(name), .-G(name) /* 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 */ @@ -160,7 +163,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] @@ -199,7 +202,7 @@ 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 END_FUNCTION(caml_alloc1) @@ -208,7 +211,7 @@ 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 END_FUNCTION(caml_alloc2) @@ -217,7 +220,7 @@ 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 END_FUNCTION(caml_alloc3) @@ -226,7 +229,7 @@ FUNCTION(caml_allocN) CFI_STARTPROC sub ALLOC_PTR, ALLOC_PTR, ARG cmp ALLOC_PTR, ALLOC_LIMIT - b.lo .Lcaml_call_gc + b.lo L(caml_call_gc) ret CFI_ENDPROC END_FUNCTION(caml_allocN) @@ -267,7 +270,7 @@ FUNCTION(caml_start_program) /* Address of OCaml code to call is in ARG */ /* 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) @@ -294,7 +297,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 @@ -303,13 +306,13 @@ FUNCTION(caml_start_program) ldr ALLOC_LIMIT, Caml_state(young_limit) /* Call the OCaml code */ blr ARG -.Lcaml_retaddr: +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) @@ -338,14 +341,14 @@ 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 /* Raise an exception from OCaml */ @@ -368,7 +371,7 @@ 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 @@ -403,7 +406,7 @@ 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 @@ -420,7 +423,7 @@ FUNCTION(caml_callback_asm) ldr x0, [x2] /* x0 = first arg */ /* x1 = closure environment */ ldr ARG, [x1] /* code pointer */ - b .Ljump_to_caml + b L(jump_to_caml) CFI_ENDPROC END_FUNCTION(caml_callback_asm) @@ -433,7 +436,7 @@ FUNCTION(caml_callback2_asm) 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 + b L(jump_to_caml) CFI_ENDPROC END_FUNCTION(caml_callback2_asm) @@ -447,7 +450,7 @@ FUNCTION(caml_callback3_asm) 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 + b L(jump_to_caml) CFI_ENDPROC END_FUNCTION(caml_callback3_asm) @@ -456,18 +459,18 @@ FUNCTION(caml_ml_array_bound_error) /* Load address of [caml_array_bound_error] in ARG */ ADDRGLOBAL(ARG, caml_array_bound_error) /* Call that function */ - b caml_c_call + b G(caml_c_call) CFI_ENDPROC 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 */ 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 diff --git a/testsuite/tools/asmgen_arm64.S b/testsuite/tools/asmgen_arm64.S index 4b803d20b..c4c058ae5 100644 --- a/testsuite/tools/asmgen_arm64.S +++ b/testsuite/tools/asmgen_arm64.S @@ -13,9 +13,11 @@ /* */ /**************************************************************************/ - .globl call_gen_code +#define G(sym) sym + + .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,7 +53,7 @@ call_gen_code: .globl caml_c_call .align 2 -caml_c_call: +G(caml_c_call): br x15 /* Mark stack as non-executable */ From f323d2ad6780da8890eec9040f89a309f93793e6 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 14:47:06 -0300 Subject: [PATCH 018/160] arm64 runtime: apply ios assembler requirements --- runtime/arm64.S | 47 +++++++++++++++++++++++++++++++++- testsuite/tools/asmgen_arm64.S | 6 +++++ 2 files changed, 52 insertions(+), 1 deletion(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index 0d2bd26c6..b1759a88f 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -50,19 +50,39 @@ #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] +/* 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(__PIC__) +#if defined(SYS_macosx) +#define ADDRGLOBAL(reg,symb) ADDRGLOBAL reg, symb + .macro ADDRGLOBAL reg, symb + adrp TMP, G(\symb)@GOTPAGE + ldr \reg, [TMP, G(\symb)@GOTPAGEOFF] + .endm +#elif defined(__PIC__) #define ADDRGLOBAL(reg,symb) \ adrp TMP, :got:G(symb); \ ldr reg, [TMP, #:got_lo12:G(symb)] @@ -90,6 +110,28 @@ G(caml_hot__code_begin): 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; \ @@ -107,6 +149,7 @@ G(name): G(name): #define END_OBJECT(name) \ .size G(name), .-G(name) +#endif /* Allocation functions and GC interface */ .globl G(caml_system__code_begin) @@ -476,5 +519,7 @@ OBJECT(caml_system__frametable) .align 3 END_OBJECT(caml_system__frametable) +#if !defined(SYS_macosx) /* Mark stack as non-executable */ .section .note.GNU-stack,"",%progbits +#endif diff --git a/testsuite/tools/asmgen_arm64.S b/testsuite/tools/asmgen_arm64.S index c4c058ae5..6a06f8d7e 100644 --- a/testsuite/tools/asmgen_arm64.S +++ b/testsuite/tools/asmgen_arm64.S @@ -13,7 +13,11 @@ /* */ /**************************************************************************/ +#if defined(SYS_macosx) +#define G(sym) _##sym +#else #define G(sym) sym +#endif .globl G(call_gen_code) .align 2 @@ -56,5 +60,7 @@ G(call_gen_code): G(caml_c_call): br x15 +#if !defined(SYS_macosx) /* Mark stack as non-executable */ .section .note.GNU-stack,"",%progbits +#endif From d189dcef6283357a4ed9439558f1b9eafb6d42cf Mon Sep 17 00:00:00 2001 From: iOS Porting Team Date: Wed, 17 Dec 2014 23:40:46 +0100 Subject: [PATCH 019/160] arm64 emitter: support apple variant of assembler --- asmcomp/arm64/emit.mlp | 57 ++++++++++++++++++++++++++++++-------- asmcomp/arm64/selection.ml | 5 +++- 2 files changed, 50 insertions(+), 12 deletions(-) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 96be20907..037a2b233 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -27,6 +27,9 @@ open Mach open Linear open Emitaux +let is_macosx = + Config.system = "macosx" + (* Tradeoff between code size and code speed *) let fastcode_flag = ref true @@ -42,14 +45,31 @@ let reg_x15 = phys_reg 15 (* Output a label *) +let label_prefix = + if is_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 is_macosx then emit_string "_"; Emitaux.emit_symbol '$' s +(* Object types *) + +let emit_symbol_type emit_lbl_or_sym lbl_or_sym ty = + if not is_macosx then begin + ` .type {emit_lbl_or_sym lbl_or_sym}, %{emit_string ty}\n` + end + + +let emit_symbol_size sym = + if not is_macosx then begin + ` .size {emit_symbol sym}, .-{emit_symbol sym}\n` + end + (* Output a pseudo-register *) let emit_reg = function @@ -320,6 +340,8 @@ let float_literal f = (* Emit all pending literals *) let emit_literals() = if !float_literals <> [] then begin + if is_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 is_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 @@ -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 is_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 @@ -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/selection.ml b/asmcomp/arm64/selection.ml index 8b1ce1b68..a40a4d8c3 100644 --- a/asmcomp/arm64/selection.ml +++ b/asmcomp/arm64/selection.ml @@ -21,6 +21,9 @@ open Arch open Cmm open Mach +let is_macosx = + Config.system = "macosx" + let is_offset chunk n = (n >= -256 && n <= 255) (* 9 bits signed unscaled *) || (n >= 0 && @@ -83,7 +86,7 @@ let inline_ops = "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ] let use_direct_addressing _symb = - not !Clflags.dlcode + (not !Clflags.dlcode) && (not is_macosx) let is_stack_slot rv = Reg.(match rv with From 8cd474f008dabeefca352f07dd18978330d8072b Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 16:20:30 -0300 Subject: [PATCH 020/160] ios: Sys.command is not supported --- configure | 54 +++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 2 ++ runtime/caml/s.h.in | 4 ++++ runtime/sys.c | 6 ++++- 4 files changed, 65 insertions(+), 1 deletion(-) diff --git a/configure b/configure index 10fe8cd84..1e685249c 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 @@ -14621,6 +14667,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 diff --git a/configure.ac b/configure.ac index cce3129fd..ec96b31d2 100644 --- a/configure.ac +++ b/configure.ac @@ -1314,6 +1314,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 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/sys.c b/runtime/sys.c index 6b67c7a8b..f1e05f6fd 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -443,7 +443,11 @@ CAMLprim value caml_sys_system_command(value command) } buf = caml_stat_strdup_to_os(String_val(command)); caml_enter_blocking_section (); - status = system_os(buf); + #if HAS_SYSTEM + status = system_os(buf); + #else + caml_invalid_argument("Sys.command not implemented"); + #endif /* HAS_SYSTEM */ caml_leave_blocking_section (); caml_stat_free(buf); if (status == -1) caml_sys_error(command); From 5e7f7c77b05e6d0cda856f69014ef95b8d1035ae Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 10 May 2020 16:21:49 -0300 Subject: [PATCH 021/160] ios: add support on configure script --- configure | 8 ++++++++ configure.ac | 6 ++++++ 2 files changed, 14 insertions(+) diff --git a/configure b/configure index 1e685249c..f42320dda 100755 --- a/configure +++ b/configure @@ -13714,6 +13714,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*) : @@ -13911,6 +13915,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) : diff --git a/configure.ac b/configure.ac index ec96b31d2..c4957c25d 100644 --- a/configure.ac +++ b/configure.ac @@ -871,6 +871,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 +979,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], From bdbd867c621d5c278640b8c2d883358d24396f5e Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Tue, 19 May 2020 23:49:23 -0300 Subject: [PATCH 022/160] arm64 runtime: use additional arg only externally --- runtime/arm64.S | 50 +++++++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index b1759a88f..37c635fa3 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -24,9 +24,9 @@ #define TRAP_PTR x26 #define ALLOC_PTR x27 #define ALLOC_LIMIT x28 -#define ARG x15 +#define ADDITIONAL_ARG x15 #define TMP x16 -#define ARG_DOMAIN_STATE_PTR x17 +#define TMP2 x17 #define C_ARG_1 x0 #define C_ARG_2 x1 @@ -79,13 +79,13 @@ #define ADDRGLOBAL(reg,symb) ADDRGLOBAL reg, symb .macro ADDRGLOBAL reg, symb - adrp TMP, G(\symb)@GOTPAGE - ldr \reg, [TMP, G(\symb)@GOTPAGEOFF] + adrp TMP2, G(\symb)@GOTPAGE + ldr \reg, [TMP2, G(\symb)@GOTPAGEOFF] .endm #elif defined(__PIC__) #define ADDRGLOBAL(reg,symb) \ - adrp TMP, :got:G(symb); \ - ldr reg, [TMP, #:got_lo12:G(symb)] + adrp TMP2, :got:G(symb); \ + ldr reg, [TMP2, #:got_lo12:G(symb)] #else #define ADDRGLOBAL(reg,symb) \ @@ -270,7 +270,7 @@ 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 L(caml_call_gc) ret @@ -278,10 +278,11 @@ FUNCTION(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 + /* I think using x19 here should be a bug */ /* Preserve return address in callee-save register x19 */ mov x19, x30 CFI_REGISTER(30, 19) @@ -293,7 +294,7 @@ 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) @@ -306,11 +307,12 @@ FUNCTION(caml_c_call) 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 */ L(jump_to_caml): @@ -330,7 +332,7 @@ L(jump_to_caml): 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) @@ -348,7 +350,7 @@ L(jump_to_caml): ldr ALLOC_PTR, Caml_state(young_ptr) ldr ALLOC_LIMIT, Caml_state(young_limit) /* Call the OCaml code */ - blr ARG + blr TMP2 L(caml_retaddr): /* Pop the trap frame, restoring caml_exception_pointer */ ldr x8, [sp], 16 @@ -462,10 +464,10 @@ 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 */ + ldr TMP2, [x1] /* code pointer */ b L(jump_to_caml) CFI_ENDPROC END_FUNCTION(caml_callback_asm) @@ -474,11 +476,11 @@ 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) + mov x2, TMP2 /* x2 = closure environment */ + ADDRGLOBAL(TMP2, caml_apply2) b L(jump_to_caml) CFI_ENDPROC END_FUNCTION(caml_callback2_asm) @@ -488,19 +490,19 @@ FUNCTION(caml_callback3_asm) /* 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) + ADDRGLOBAL(TMP2, caml_apply3) b L(jump_to_caml) CFI_ENDPROC 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 G(caml_c_call) CFI_ENDPROC From 8c38ac6bf6fc9e3cd285c55d4da26dfa413d843d Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 21 Jun 2020 01:24:53 -0300 Subject: [PATCH 023/160] arm64: support ios shared library * the stub on iOS also saves x8 and x9 * use x8 for ADDITIONAL_ARG * use only 8 regs for calling args --- asmcomp/arm64/emit.mlp | 6 +++--- asmcomp/arm64/proc.ml | 13 ++++++++----- runtime/arm64.S | 2 +- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 037a2b233..ef0dd2616 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -41,7 +41,7 @@ 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 *) @@ -587,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` @@ -685,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) -> diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml index f9c73f2fd..ae5b3ac26 100644 --- a/asmcomp/arm64/proc.ml +++ b/asmcomp/arm64/proc.ml @@ -47,6 +47,8 @@ let word_addressed = false d16 - d31 general purpose (caller-save) *) +let is_macosx = Config.system = "macosx" + let int_reg_name = [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7"; "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15"; @@ -99,7 +101,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 +167,14 @@ 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 is_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 +255,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/runtime/arm64.S b/runtime/arm64.S index 37c635fa3..87a08dca9 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -24,7 +24,7 @@ #define TRAP_PTR x26 #define ALLOC_PTR x27 #define ALLOC_LIMIT x28 -#define ADDITIONAL_ARG x15 +#define ADDITIONAL_ARG x8 #define TMP x16 #define TMP2 x17 From 99664ee0a4489f80d1b59ff5b25526338e64bbbd Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Mon, 22 Jun 2020 19:00:56 -0300 Subject: [PATCH 024/160] ios: dead lock on Sys.command Co-authored-by: Anil Madhavapeddy --- runtime/sys.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime/sys.c b/runtime/sys.c index f1e05f6fd..9b9102fb5 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -442,13 +442,13 @@ CAMLprim value caml_sys_system_command(value command) caml_sys_error(command); } buf = caml_stat_strdup_to_os(String_val(command)); - caml_enter_blocking_section (); #if HAS_SYSTEM + caml_enter_blocking_section (); status = system_os(buf); + caml_leave_blocking_section (); #else caml_invalid_argument("Sys.command not implemented"); #endif /* HAS_SYSTEM */ - caml_leave_blocking_section (); caml_stat_free(buf); if (status == -1) caml_sys_error(command); if (WIFEXITED(status)) From 9a98d40b86a8c8f03877af1d5786314ab78954e8 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Wed, 24 Jun 2020 15:46:47 -0300 Subject: [PATCH 025/160] arm64: add reference to Apple ARM64 ABI --- asmcomp/arm64/NOTES.md | 1 + 1 file changed, 1 insertion(+) 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_ From 69d4ab80d09e4cbc52f67afc19903e6c05ef477e Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Thu, 2 Jul 2020 01:42:42 -0300 Subject: [PATCH 026/160] arm64: use Arch.macosx instead of is_macosx Also remove the duplicated declaration from proc.ml and emit.mlp Co-authored-by: Xavier Leroy --- asmcomp/arm64/emit.mlp | 17 +++++++---------- asmcomp/arm64/proc.ml | 4 +--- asmcomp/arm64/selection.ml | 5 +---- 3 files changed, 9 insertions(+), 17 deletions(-) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index ef0dd2616..d5b5caee0 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -27,9 +27,6 @@ open Mach open Linear open Emitaux -let is_macosx = - Config.system = "macosx" - (* Tradeoff between code size and code speed *) let fastcode_flag = ref true @@ -46,7 +43,7 @@ let reg_x8 = phys_reg 8 (* Output a label *) let label_prefix = - if is_macosx then "L" else ".L" + if macosx then "L" else ".L" let emit_label lbl = emit_string label_prefix; emit_int lbl @@ -54,19 +51,19 @@ let emit_label lbl = (* Symbols *) let emit_symbol s = - if is_macosx then emit_string "_"; + 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 is_macosx then begin + 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 is_macosx then begin + if not macosx then begin ` .size {emit_symbol sym}, .-{emit_symbol sym}\n` end @@ -340,7 +337,7 @@ let float_literal f = (* Emit all pending literals *) let emit_literals() = if !float_literals <> [] then begin - if is_macosx then + if macosx then ` .section __TEXT,__literal8,8byte_literals\n`; ` .align 3\n`; List.iter @@ -353,7 +350,7 @@ let emit_literals() = (* Emit code to load the address of a symbol *) let emit_load_symbol_addr dst s = - if is_macosx 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 @@ -605,7 +602,7 @@ let emit_named_text_section func_name = (* Emit code to load an emitted literal *) let emit_load_literal dst lbl = - if is_macosx then begin + 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 diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml index ae5b3ac26..c95bbb944 100644 --- a/asmcomp/arm64/proc.ml +++ b/asmcomp/arm64/proc.ml @@ -47,8 +47,6 @@ let word_addressed = false d16 - d31 general purpose (caller-save) *) -let is_macosx = Config.system = "macosx" - let int_reg_name = [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7"; "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15"; @@ -167,7 +165,7 @@ 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 is_macosx then 7 else 15 +let last_int_register = if macosx then 7 else 15 let loc_arguments arg = calling_conventions 0 last_int_register 100 115 outgoing arg diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml index a40a4d8c3..45305de73 100644 --- a/asmcomp/arm64/selection.ml +++ b/asmcomp/arm64/selection.ml @@ -21,9 +21,6 @@ open Arch open Cmm open Mach -let is_macosx = - Config.system = "macosx" - let is_offset chunk n = (n >= -256 && n <= 255) (* 9 bits signed unscaled *) || (n >= 0 && @@ -86,7 +83,7 @@ let inline_ops = "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ] let use_direct_addressing _symb = - (not !Clflags.dlcode) && (not is_macosx) + (not !Clflags.dlcode) && (not Arch.macosx) let is_stack_slot rv = Reg.(match rv with From 83a06c3d1582cc582ae575a1145edca1432476d9 Mon Sep 17 00:00:00 2001 From: iOS Porting Team Date: Thu, 27 Nov 2014 17:03:04 +0100 Subject: [PATCH 027/160] On the iPhone simulator the machine context field has two underscores --- runtime/signals_osdep.h | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) 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 From a651a824882370beecd5a2dd15e8a086eb9ab91f Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 25 Jul 2020 10:04:31 +0100 Subject: [PATCH 028/160] Fix handling of EOL-at-EOF in ocamltest --- .gitattributes | 4 + Changes | 4 + ocamltest/filecompare.ml | 122 ++++++++++++++---- ocamltest/ocamltest_stdlib.ml | 10 ++ ocamltest/ocamltest_stdlib.mli | 6 + testsuite/tests/tool-ocamltest/norm1.ml | 5 + .../tests/tool-ocamltest/norm1.reference | 1 + testsuite/tests/tool-ocamltest/norm2.ml | 5 + .../tests/tool-ocamltest/norm2.reference | 2 + testsuite/tests/tool-ocamltest/norm3.ml | 5 + .../tests/tool-ocamltest/norm3.reference | 2 + testsuite/tests/tool-ocamltest/norm4.ml | 5 + .../tests/tool-ocamltest/norm4.reference | 2 + 13 files changed, 147 insertions(+), 26 deletions(-) create mode 100644 testsuite/tests/tool-ocamltest/norm1.ml create mode 100644 testsuite/tests/tool-ocamltest/norm1.reference create mode 100644 testsuite/tests/tool-ocamltest/norm2.ml create mode 100644 testsuite/tests/tool-ocamltest/norm2.reference create mode 100644 testsuite/tests/tool-ocamltest/norm3.ml create mode 100644 testsuite/tests/tool-ocamltest/norm3.reference create mode 100644 testsuite/tests/tool-ocamltest/norm4.ml create mode 100644 testsuite/tests/tool-ocamltest/norm4.reference diff --git a/.gitattributes b/.gitattributes index 296d539a8..eebcdcffb 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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/Changes b/Changes index af1cf4547..bea944817 100644 --- a/Changes +++ b/Changes @@ -342,6 +342,10 @@ Working version (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) + ### Build system: - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml index 9bad9af3c..9e502019c 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. *) diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index e6ce21d7f..a6ee5319f 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -185,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 f6605b6cf..f28bf05a3 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -61,6 +61,12 @@ module Sys : sig 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/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 From 6a4f9aef5fb0705cc062c05560ad4f0c60ecc4d0 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 25 Jul 2020 10:36:24 +0100 Subject: [PATCH 029/160] Report a diff for files differing by endings only --- ocamltest/filecompare.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml index 9e502019c..97d00ff33 100644 --- a/ocamltest/filecompare.ml +++ b/ocamltest/filecompare.ml @@ -231,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 From f817b25c76100b96751014ea991738991c48861a Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 26 Jul 2020 21:19:20 +0000 Subject: [PATCH 030/160] ios: memory leak when Sys.command failed MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * as we raised an exception, caml_stat_free never happens Co-authored-by: Nicolás Ojeda Bär q --- runtime/sys.c | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/runtime/sys.c b/runtime/sys.c index 9b9102fb5..b401d47e1 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -431,6 +431,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); @@ -442,13 +443,9 @@ CAMLprim value caml_sys_system_command(value command) caml_sys_error(command); } buf = caml_stat_strdup_to_os(String_val(command)); - #if HAS_SYSTEM - caml_enter_blocking_section (); - status = system_os(buf); - caml_leave_blocking_section (); - #else - caml_invalid_argument("Sys.command not implemented"); - #endif /* HAS_SYSTEM */ + caml_enter_blocking_section (); + status = system_os(buf); + caml_leave_blocking_section (); caml_stat_free(buf); if (status == -1) caml_sys_error(command); if (WIFEXITED(status)) @@ -457,6 +454,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) { From cf6ecb7816aaf683d5793519d75fda1f404fd810 Mon Sep 17 00:00:00 2001 From: EduardoRFS Date: Sun, 26 Jul 2020 21:21:37 +0000 Subject: [PATCH 031/160] arm64: remove misleading comment --- runtime/arm64.S | 1 - 1 file changed, 1 deletion(-) diff --git a/runtime/arm64.S b/runtime/arm64.S index 87a08dca9..200154f88 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -282,7 +282,6 @@ FUNCTION(caml_allocN) FUNCTION(caml_c_call) CFI_STARTPROC - /* I think using x19 here should be a bug */ /* Preserve return address in callee-save register x19 */ mov x19, x30 CFI_REGISTER(30, 19) From 2317acc0c0e2886c5341b2204afb1685b8710401 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 27 Jul 2020 16:28:27 +0100 Subject: [PATCH 032/160] Return tests in alphabetical order --- ocamltest/main.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/ocamltest/main.ml b/ocamltest/main.ml index 1fcdb4825..12b0c06c0 100644 --- a/ocamltest/main.ml +++ b/ocamltest/main.ml @@ -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() From a9fc1cd84fa23bab387b285f3b7e542c64dc3f76 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 27 Jul 2020 16:33:41 +0100 Subject: [PATCH 033/160] Assume --no-print-directory option At the time the test was added, GNU make was not a requirement. It is now, an --no-print-directory was added in 1993... --- testsuite/Makefile | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/testsuite/Makefile b/testsuite/Makefile index 924f78d11..be6c58582 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 := .. @@ -110,8 +108,8 @@ 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 @@ -136,9 +134,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 +175,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 @@ -192,9 +190,9 @@ list: lib tools exit 1; \ fi @while read LINE; do \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE; \ + $(MAKE) --no-print-directory exec-one DIR=$$LINE; \ done <$(FILE) 2>&1 | tee $(TESTLOG) - @$(MAKE) $(NO_PRINT) retries + @$(MAKE) --no-print-directory retries @$(MAKE) report .PHONY: one @@ -207,7 +205,7 @@ one: lib tools echo "Directory '$(DIR)' does not exist."; \ exit 1; \ fi - @$(MAKE) $(NO_PRINT) exec-one DIR=$(DIR) + @$(MAKE) --no-print-directory exec-one DIR=$(DIR) @$(MAKE) check-failstamp .PHONY: exec-one @@ -290,18 +288,17 @@ retry-list: @while read LINE; do \ if [ -n "$$LINE" ] ; then \ echo re-ran $$LINE>> $(TESTLOG); \ - $(MAKE) $(NO_PRINT) clean-one DIR=$$LINE; \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE 2>&1 | tee -a $(TESTLOG) ; \ + $(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: From e6788850078974de6fc5eaee70fe463d24d953db Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Wed, 24 Jun 2020 15:54:25 +0100 Subject: [PATCH 034/160] Lock channels before doing I/O The debugger's use of channels doesn't support locking, but it doesn't work on threaded programs anyway. --- ocamltest/run_stubs.c | 2 ++ runtime/backtrace_byt.c | 2 ++ runtime/caml/io.h | 2 +- runtime/debugger.c | 6 ++++++ runtime/startup_byt.c | 2 ++ 5 files changed, 13 insertions(+), 1 deletion(-) 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/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/io.h b/runtime/caml/io.h index 2d961f956..162cd9018 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -65,7 +65,7 @@ enum { */ /* Functions and macros that can be called from C. Take arguments of - type struct channel *. No locking is performed. */ + type struct channel *. The channel must be locked before calling these. */ #define caml_putch(channel, ch) do{ \ if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \ 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/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. */ From 32feddc1fc0a1bd03c44bb4d74d02f53ce39840e Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Wed, 24 Jun 2020 16:21:30 +0100 Subject: [PATCH 035/160] Do not run OCaml code inside signal handlers --- otherlibs/systhreads/st_stubs.c | 10 ---------- runtime/caml/compatibility.h | 1 - runtime/caml/signals.h | 1 - runtime/signals.c | 15 --------------- runtime/signals_byt.c | 7 +------ runtime/signals_nat.c | 11 +++-------- 6 files changed, 4 insertions(+), 41 deletions(-) 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/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/signals.h b/runtime/caml/signals.h index 7ec1ad3ba..feaa17eb4 100644 --- a/runtime/caml/signals.h +++ b/runtime/caml/signals.h @@ -86,7 +86,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/signals.c b/runtime/signals.c index 57bb3fc71..58f37775a 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -136,33 +136,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) 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; } From 63d516bda140ea7524523c62038e1f6d4ca004aa Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Wed, 24 Jun 2020 17:16:21 +0100 Subject: [PATCH 036/160] Avoid running signal handlers while holding locks in io.c --- runtime/caml/io.h | 16 +++++---- runtime/caml/osdeps.h | 10 ++++-- runtime/caml/signals.h | 4 +++ runtime/io.c | 80 ++++++++++++++++++++++++++++++------------ runtime/signals.c | 13 ++++++- runtime/unix.c | 17 ++++----- runtime/win32.c | 8 ++--- 7 files changed, 104 insertions(+), 44 deletions(-) diff --git a/runtime/caml/io.h b/runtime/caml/io.h index 162cd9018..bc8316084 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -64,8 +64,15 @@ 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 *. The channel must be locked before calling these. */ +/* 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 *); + + +/* 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 +84,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 *); diff --git a/runtime/caml/osdeps.h b/runtime/caml/osdeps.h index d41779d3f..74a3558fd 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 diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h index feaa17eb4..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]). */ diff --git a/runtime/io.c b/runtime/io.c index 1db7ef0f7..f36f3251c 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -69,13 +69,24 @@ 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); + } +} + 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; @@ -131,12 +142,13 @@ CAMLexport file_offset caml_channel_size(struct channel *channel) file_offset offset; file_offset 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(); + caml_enter_blocking_section_no_pending(); end = lseek(fd, 0, SEEK_END); if (end == -1 || lseek(fd, offset, SEEK_SET) != offset) { caml_leave_blocking_section(); @@ -167,12 +179,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 +217,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 +230,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 +250,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); @@ -259,16 +269,22 @@ CAMLexport file_offset caml_pos_out(struct channel *channel) /* caml_do_read is exported for Cash */ CAMLexport int caml_do_read(int fd, char *p, unsigned int n) { - return caml_read_fd(fd, 0, p, n); + 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 +308,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 +323,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; @@ -335,7 +353,7 @@ CAMLexport void caml_seek_in(struct channel *channel, file_offset dest) dest <= channel->offset) { 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); @@ -355,7 +373,8 @@ CAMLexport 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 +397,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. */ @@ -545,7 +565,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 +583,27 @@ 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); + if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); } + CAMLreturnT(file_offset, size); +} + CAMLprim value caml_ml_channel_size(value vchannel) { - file_offset size = caml_channel_size(Channel(vchannel)); - if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); } - return Val_long(size); + return Val_long(ml_channel_size(vchannel)); } 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) @@ -731,6 +762,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 +780,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/signals.c b/runtime/signals.c index 58f37775a..c5daa02d1 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -163,6 +163,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; @@ -183,7 +188,7 @@ CAMLexport void caml_leave_blocking_section(void) [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()); + //caml_raise_if_exception(caml_process_pending_signals_exn()); errno = saved_errno; } @@ -322,6 +327,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/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/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()); From 82625c6105e6c6cd3f190b6790e5c9bb2d50b186 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 28 Jul 2020 10:27:07 +0200 Subject: [PATCH 037/160] test/unwind: exit with nonzero error code in case of failure Follow-up to d374d7d23 --- testsuite/tests/unwind/stack_walker.c | 1 + 1 file changed, 1 insertion(+) 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; } From 15b9d006a4792c88d0c461e8280d932364cb1404 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Mon, 27 Jul 2020 16:12:10 +0100 Subject: [PATCH 038/160] Avoid polling in caml_leave_blocking_section To preserve behaviour, explicit polls are added: - in caml_raise, to raise the right exception when as system call is interrupted by a signal. - in sigprocmask, to ensure that signals are handled as soon as they are unmasked. --- otherlibs/systhreads/st_posix.h | 2 ++ otherlibs/unix/signals.c | 2 ++ runtime/fail_byt.c | 2 ++ runtime/fail_nat.c | 4 ++++ runtime/signals.c | 24 ++++++++++++++---------- 5 files changed, 24 insertions(+), 10 deletions(-) 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/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/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/signals.c b/runtime/signals.c index c5daa02d1..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 @@ -187,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; } From c2b2da223472aedb2a4f21efe0c3a8ea1d542719 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Mon, 27 Jul 2020 17:14:48 +0100 Subject: [PATCH 039/160] Tests for EINTR-based signal handling --- testsuite/tests/lib-systhreads/eintr.ml | 91 +++++++++++++++++++ .../tests/lib-systhreads/eintr.reference | 4 + 2 files changed, 95 insertions(+) create mode 100644 testsuite/tests/lib-systhreads/eintr.ml create mode 100644 testsuite/tests/lib-systhreads/eintr.reference 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 From df705bce123fd3ec4ea5a626a75ad82ff50f797d Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 28 Jul 2020 10:57:44 +0100 Subject: [PATCH 040/160] Fix running toplevel tests in ocamltest Fault in the logic for toplevel tests meant the win-unicode tests were never running. --- ocamltest/ocaml_actions.ml | 147 ++++++++++++++++++------------------- 1 file changed, 72 insertions(+), 75 deletions(-) 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" From 44e6cf4e0f2d03a6699d0375a9465bb45613aaa0 Mon Sep 17 00:00:00 2001 From: Fourchaux Date: Tue, 28 Jul 2020 13:22:03 +0200 Subject: [PATCH 041/160] typos (#9806) --- Changes | 2 +- HACKING.adoc | 6 +++--- Makefile.config.in | 2 +- asmcomp/selectgen.ml | 2 +- asmcomp/selectgen.mli | 2 +- lambda/simplif.ml | 2 +- parsing/parse.mli | 2 +- testsuite/Makefile | 2 +- typing/typedecl.ml | 2 +- typing/typetexp.ml | 2 +- 10 files changed, 12 insertions(+), 12 deletions(-) diff --git a/Changes b/Changes index fc9aaf96f..8d4541862 100644 --- a/Changes +++ b/Changes @@ -90,7 +90,7 @@ 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 occuring +- #9742: Ephemerons are now compatible with infix pointers occurring when using mutually recursive functions. (Jacques-Henri Jourdan, review François Bobot) 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.config.in b/Makefile.config.in index 35fd7aedd..3228a5a6f 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. 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/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/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/testsuite/Makefile b/testsuite/Makefile index 5cd2d6dfa..924f78d11 100644 --- a/testsuite/Makefile +++ b/testsuite/Makefile @@ -75,7 +75,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 := 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. *) From 274cb3c3cec80caa6897636b8dd879acec3377f3 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 28 Jul 2020 16:39:21 +0200 Subject: [PATCH 042/160] Changes entry for #9699 --- Changes | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Changes b/Changes index 8d4541862..be8a0aca1 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, From e0b5f5e1cf1e7c6a7617153cc570e5b18ec6799b Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Mon, 29 Jun 2020 15:37:50 +0100 Subject: [PATCH 043/160] Changes --- Changes | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Changes b/Changes index fc9aaf96f..b187b9c19 100644 --- a/Changes +++ b/Changes @@ -94,6 +94,16 @@ Working version 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) + ### Code generation and optimizations: - #9551: ocamlc no longer loads DLLs at link time to check that From a741f25803cebeb3e90895d10bf05c328ad01faf Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Mon, 27 Jul 2020 16:13:28 +0100 Subject: [PATCH 044/160] Build otherlibs with debug info in C stubs --- Changes | 3 +++ otherlibs/Makefile.otherlibs.common | 4 ++++ otherlibs/systhreads/Makefile | 4 ++++ 3 files changed, 11 insertions(+) diff --git a/Changes b/Changes index fc9aaf96f..7cf9b8134 100644 --- a/Changes +++ b/Changes @@ -292,6 +292,9 @@ 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) + ### Bug fixes: - #7902, #9556: Type-checker infers recursive type, even though -rectypes is diff --git a/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common index 1d43b1315..781db8e75 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) diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index 7852bc89b..fb2740bc2 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 From 302d735ce8f965f48784b90af11aaeddf22f88d1 Mon Sep 17 00:00:00 2001 From: Jacques Garrigue Date: Wed, 29 Jul 2020 09:10:17 +0900 Subject: [PATCH 045/160] Righteous ambivalence (#9767) * Fix #9759: Typing without -principal is broken in 4.11 and trunk * compile stdlib in -principal mode * never modify generic part of ty_expected_explained * use generic_instance where possible * add comment for -no-principal in stdlib__oo.cmi --- Changes | 4 +++ stdlib/Compflags | 2 ++ stdlib/Makefile | 2 +- stdlib/camlinternalFormat.ml | 4 +-- testsuite/tests/typing-gadts/pr9759.ml | 31 ++++++++++++++++++++ typing/printtyp.ml | 4 +-- typing/typecore.ml | 40 ++++++++------------------ 7 files changed, 54 insertions(+), 33 deletions(-) create mode 100644 testsuite/tests/typing-gadts/pr9759.ml diff --git a/Changes b/Changes index 8fa6ea1f1..37bd0774c 100644 --- a/Changes +++ b/Changes @@ -344,6 +344,10 @@ Working version 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 ---------- diff --git a/stdlib/Compflags b/stdlib/Compflags index 3fa37a365..61f26a925 100755 --- a/stdlib/Compflags +++ b/stdlib/Compflags @@ -34,5 +34,7 @@ case $1 in stdlib__scanf.cmx) echo ' -inline 9';; *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/Makefile b/stdlib/Makefile index 441cedaa0..9fbc01986 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) 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/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/typing/printtyp.ml b/typing/printtyp.ml index cfb5015de..07b22e673 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 diff --git a/typing/typecore.ml b/typing/typecore.ml index a49f53d5d..69282be05 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 From 24744e8dd8b35370fea31d0c032220ebf0cfa782 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 30 Jul 2020 10:23:17 +0200 Subject: [PATCH 046/160] cehck-typo --- asmcomp/arm64/proc.ml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml index c95bbb944..e259d2038 100644 --- a/asmcomp/arm64/proc.ml +++ b/asmcomp/arm64/proc.ml @@ -170,9 +170,15 @@ let last_int_register = if macosx then 7 else 15 let loc_arguments arg = calling_conventions 0 last_int_register 100 115 outgoing arg let loc_parameters arg = - let (loc, _) = calling_conventions 0 last_int_register 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 last_int_register 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 From 5b4b834578c2cb3674ef4b68e4ce8b447590af3c Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Thu, 30 Jul 2020 14:30:42 +0100 Subject: [PATCH 047/160] Ensure signals are handled before Unix.{kill,sigprocmask} return (#9802) --- Changes | 3 +++ otherlibs/unix/kill.c | 1 + testsuite/tests/callback/callbackprim.c | 7 +++++ testsuite/tests/callback/signals_alloc.ml | 6 ++--- testsuite/tests/callback/tcallback.ml | 9 +++---- testsuite/tests/lib-unix/kill/unix_kill.ml | 26 +++++++++++++++++++ .../tests/lib-unix/kill/unix_kill.reference | 2 ++ 7 files changed, 45 insertions(+), 9 deletions(-) create mode 100644 testsuite/tests/lib-unix/kill/unix_kill.ml create mode 100644 testsuite/tests/lib-unix/kill/unix_kill.reference diff --git a/Changes b/Changes index c958ce773..88508ecd9 100644 --- a/Changes +++ b/Changes @@ -197,6 +197,9 @@ Working version error handling when Unix.symlink is unavailable) (David Allsopp, review by Xavier Leroy) +- #9802: Ensure signals are handled before Unix.kill returns + (Stephen Dolan, review by Jacques-Henri Jourdan) + ### Tools: - #9551: ocamlobjinfo is now able to display information on .cmxs shared 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/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..aa204729c 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" [@@noalloc] let do_test () = let seen_states = Array.make 5 (-1) in @@ -19,7 +19,7 @@ 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; 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/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 From 482b7feb3743e140fd79c2b1bf929f2b738d42eb Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Fri, 31 Jul 2020 09:04:20 +0200 Subject: [PATCH 048/160] Skip tests/unwind on iOS / macOS ARM64 On iOS / macOS ARM64, libunwind seems unable to unwind anything, not just OCaml function calls, but even C function calls. Maybe this is related to the observation that the C compiler doesn't produce DWARF unwinding info by default. The DWARF unwinding info produced by ocamlopt seems correct, given that lldb prints correct stack backtraces for this "unwind" example. --- testsuite/tests/unwind/driver.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/unwind/driver.ml b/testsuite/tests/unwind/driver.ml index 421f85a66..c6cdd6346 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 +** 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 *) From 8b6241c64c8e02a02daa7c4aa6c2181238023834 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Fri, 31 Jul 2020 09:29:43 +0200 Subject: [PATCH 049/160] Skip tests/unwind on iOS / macOS ARM64, continued Follow-up to 482b7feb3 --- testsuite/tests/unwind/driver.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/unwind/driver.ml b/testsuite/tests/unwind/driver.ml index c6cdd6346..38fd7f064 100644 --- a/testsuite/tests/unwind/driver.ml +++ b/testsuite/tests/unwind/driver.ml @@ -4,7 +4,7 @@ script = "sh ${test_source_directory}/check-linker-version.sh" files = "mylib.mli mylib.ml stack_walker.c" * macos -** amd64 +** arch_amd64 *** script **** setup-ocamlopt.byte-build-env ***** ocamlopt.byte From 0bf255cd7e01d2460b061d4273c82cb0a86deaf1 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Sun, 2 Aug 2020 20:30:58 +0100 Subject: [PATCH 050/160] Fix signals_alloc test (#9814) --- testsuite/tests/callback/signals_alloc.ml | 5 +++-- testsuite/tests/callback/signals_alloc.reference | 11 +++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/callback/signals_alloc.ml b/testsuite/tests/callback/signals_alloc.ml index aa204729c..27ed2f7da 100644 --- a/testsuite/tests/callback/signals_alloc.ml +++ b/testsuite/tests/callback/signals_alloc.ml @@ -5,7 +5,7 @@ ** bytecode ** native *) -external raise_sigusr1 : unit -> unit = "raise_sigusr1" [@@noalloc] +external raise_sigusr1 : unit -> unit = "raise_sigusr1" let do_test () = let seen_states = Array.make 5 (-1) in @@ -24,7 +24,8 @@ let do_test () = 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 From 7c1cf4bc957ecaf9022fb32c26adffb7f108100d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 3 Aug 2020 11:44:49 +0200 Subject: [PATCH 051/160] caml_alloc_some: use Field as an l-value instead of Store_field (#9819) --- runtime/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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); } From 4d7e78f224d4244aaa124b77f1cbd5e65daefaaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 3 Aug 2020 15:01:34 +0200 Subject: [PATCH 052/160] tools/ci/inria/extra-checks: fix typos --- tools/ci/inria/extra-checks | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index 641250392..dec4cac90 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -106,7 +106,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 From 5cb221804464278aada779ef76cfc1d4eb537daf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 3 Aug 2020 15:03:18 +0200 Subject: [PATCH 053/160] tools/ci/inria/extra-checks: print each command before its execution --- tools/ci/inria/extra-checks | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index dec4cac90..7a30ed1b1 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -59,6 +59,10 @@ set_config_var() { } ######################################################################### + +# Print each command before its execution +set -x + # stop on error set -e From 2d927d8be6efcea7e3f0e09da42fefe4e13c389d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 3 Aug 2020 15:41:02 +0200 Subject: [PATCH 054/160] tools/ci/inria/extra-checks: stop mentionninig world.opt explicitly this is now what's happening by default when the bytecode compiler has not been disabled, and it has not, here. --- tools/ci/inria/extra-checks | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index 7a30ed1b1..4beff77cf 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -185,7 +185,7 @@ set_config_var OC_CFLAGS "-O1 \ OCAMLRUNPARAM="c=1" \ LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/lsan-suppr.txt" \ -make $jobs world.opt +make $jobs # Run the testsuite. # We deactivate leak detection for two reasons: @@ -215,7 +215,7 @@ set_config_var OC_CFLAGS "-O1 \ -fsanitize=thread" # Build the system -make $jobs world.opt +make $jobs # Run the testsuite. # ThreadSanitizer complains about fork() in threaded programs, From f3e7475b6a6eaa82a0d114b00c0e3d1faa59c8f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 3 Aug 2020 16:43:46 +0200 Subject: [PATCH 055/160] tools/ci/inria/extra-checks: fix another typo --- tools/ci/inria/extra-checks | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index 4beff77cf..821c00310 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -248,7 +248,7 @@ TSAN_OPTIONS="die_after_fork=0" $run_testsuite # -Wall -Werror \ # -fsanitize=memory" -# # A tool that make error backtrace nicer +# # 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 From bf888763cdfdfd067fd5e0b513dc00d76f067a58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 3 Aug 2020 16:44:23 +0200 Subject: [PATCH 056/160] tools/ci/inria/extra-checks: stop mentionning the world target This change is similar to the one in commit 2d927d8be6efcea7e3f. --- tools/ci/inria/extra-checks | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index 821c00310..1a9663839 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -253,5 +253,5 @@ TSAN_OPTIONS="die_after_fork=0" $run_testsuite # 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 From 3f5c5ca8207c1c82e2ee08bcefeddad2a346af5c Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Mon, 3 Aug 2020 18:47:40 +0100 Subject: [PATCH 057/160] fix floatarray.ml on 32-bit --- testsuite/tests/lib-floatarray/floatarray.ml | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) 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) From 8905edd38223ef87c957a4fff03ebf0e437769fa Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 4 Aug 2020 15:01:50 +0100 Subject: [PATCH 058/160] Trivial correction to stdlib/HACKING.adoc --- stdlib/HACKING.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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. From 1964506dbefa27cdf7a1ffc2244f095a793ac334 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Wed, 5 Aug 2020 11:17:52 +0200 Subject: [PATCH 059/160] Fix type mismatches between definition and declaration (#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 can cause link-time errors with link-time optimization (LTO). Closes: #9825 --- Changes | 7 +++++++ runtime/major_gc.c | 4 ++-- runtime/spacetime_byt.c | 7 ++++++- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 88508ecd9..7660c7c43 100644 --- a/Changes +++ b/Changes @@ -354,6 +354,13 @@ Working version (Jacques Garrigue, report by Thomas Refis, review by Thomas Refis and Gabriel Scherer) +- #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) + + OCaml 4.11 ---------- 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/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; } From aa06fa819ef1c6774e73bd8ca1a5c1a78397ff45 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Wed, 5 Aug 2020 10:49:13 +0100 Subject: [PATCH 060/160] Add a failing test for #show with -short-paths. --- .../tests/tool-toplevel/show_short_paths.ml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 testsuite/tests/tool-toplevel/show_short_paths.ml 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..000e77523 --- /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 'a list = [] | (::) of 'a * 'a list +|}];; + +type 'a t;; +#show t;; +[%%expect {| +type 'a t +type 'a t +|}];; From 27f1012bc63e062adb63b4b9d6639588bfe1356a Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Wed, 5 Aug 2020 11:00:19 +0100 Subject: [PATCH 061/160] Revert to printing types as 'nonrec' to avoid a bug See: https://github.com/ocaml/ocaml/issues/9828 --- .../tool-toplevel/known-bugs/broken_rec_in_show.ml | 14 +++++++------- testsuite/tests/tool-toplevel/show.ml | 6 +++--- testsuite/tests/tool-toplevel/show_short_paths.ml | 4 ++-- toplevel/topdirs.ml | 2 +- 4 files changed, 13 insertions(+), 13 deletions(-) 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/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 index 000e77523..c0c50de20 100644 --- a/testsuite/tests/tool-toplevel/show_short_paths.ml +++ b/testsuite/tests/tool-toplevel/show_short_paths.ml @@ -8,12 +8,12 @@ #show list;; [%%expect {| -type 'a list = [] | (::) of 'a * 'a list +type nonrec 'a list = [] | (::) of 'a * 'a list |}];; type 'a t;; #show t;; [%%expect {| type 'a t -type 'a t +type nonrec 'a t |}];; 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." From 395a47eed99eb2bbe872e346bc0b459b28108b02 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Wed, 5 Aug 2020 13:26:10 +0100 Subject: [PATCH 062/160] Add Bigarray 'init' functions (#9779) Add Bigarray init functions. --- Changes | 4 + stdlib/bigarray.ml | 69 +++++++ stdlib/bigarray.mli | 88 ++++++++- testsuite/tests/lib-bigarray/bigarrays.ml | 168 +++++++++++++++++- .../tests/lib-bigarray/bigarrays.reference | 10 ++ 5 files changed, 336 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 7660c7c43..afd48b6b0 100644 --- a/Changes +++ b/Changes @@ -133,6 +133,10 @@ Working version - #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) 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/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... From df9d60f3151b90d0f8718ae82746d59dea931216 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 28 Jul 2020 17:48:32 +0200 Subject: [PATCH 063/160] Get rid of the YACCFLAGS build variable It was not used, except in lex/Makefile where this commit replaces its unique occurrence by its definition in the same file. --- Makefile | 1 - debugger/Makefile | 1 - lex/Makefile | 3 +-- 3 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 54d8e9df6..4455a6fd1 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 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/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 From 829b00b6c7530825bc927168c8f2f3f092f78143 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Wed, 5 Aug 2020 18:11:11 +0100 Subject: [PATCH 064/160] Restrict 'test_locations' to not run with afl active The AFL code generator alters the generated output and the expect tests fail. This test is already restricted to 64-bit only architectures for similar reasons (the output locations change). Also updates the expected outputs to account for the extra line in the test case now. Fixes #9822 --- ...test_locations.dlocations.ocamlc.reference | 116 +++++++++--------- ...ions.dlocations.ocamlopt.clambda.reference | 6 +- ...ions.dlocations.ocamlopt.flambda.reference | 6 +- testsuite/tests/formatting/test_locations.ml | 37 +++--- 4 files changed, 83 insertions(+), 82 deletions(-) diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference index e85e57739..fe3fe29a5 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[43,1389+0]..[45,1427+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[43,1389+8]..[43,1389+11]) + Ppat_var "fib" (test_locations.ml[43,1389+8]..[43,1389+11]) + expression (test_locations.ml[43,1389+14]..[45,1427+34]) Pexp_function [ - pattern (test_locations.ml[43,1373+4]..[43,1373+9]) + pattern (test_locations.ml[44,1412+4]..[44,1412+9]) Ppat_or - pattern (test_locations.ml[43,1373+4]..[43,1373+5]) + pattern (test_locations.ml[44,1412+4]..[44,1412+5]) Ppat_constant PConst_int (0,None) - pattern (test_locations.ml[43,1373+8]..[43,1373+9]) + pattern (test_locations.ml[44,1412+8]..[44,1412+9]) Ppat_constant PConst_int (1,None) - expression (test_locations.ml[43,1373+13]..[43,1373+14]) + expression (test_locations.ml[44,1412+13]..[44,1412+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[45,1427+4]..[45,1427+5]) + Ppat_var "n" (test_locations.ml[45,1427+4]..[45,1427+5]) + expression (test_locations.ml[45,1427+9]..[45,1427+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[45,1427+21]..[45,1427+22]) + Pexp_ident "+" (test_locations.ml[45,1427+21]..[45,1427+22]) [ Nolabel - expression (test_locations.ml[44,1388+9]..[44,1388+20]) + expression (test_locations.ml[45,1427+9]..[45,1427+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[45,1427+9]..[45,1427+12]) + Pexp_ident "fib" (test_locations.ml[45,1427+9]..[45,1427+12]) [ Nolabel - expression (test_locations.ml[44,1388+13]..[44,1388+20]) + expression (test_locations.ml[45,1427+13]..[45,1427+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[45,1427+16]..[45,1427+17]) + Pexp_ident "-" (test_locations.ml[45,1427+16]..[45,1427+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[45,1427+14]..[45,1427+15]) + Pexp_ident "n" (test_locations.ml[45,1427+14]..[45,1427+15]) Nolabel - expression (test_locations.ml[44,1388+18]..[44,1388+19]) + expression (test_locations.ml[45,1427+18]..[45,1427+19]) Pexp_constant PConst_int (1,None) ] ] Nolabel - expression (test_locations.ml[44,1388+23]..[44,1388+34]) + expression (test_locations.ml[45,1427+23]..[45,1427+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[45,1427+23]..[45,1427+26]) + Pexp_ident "fib" (test_locations.ml[45,1427+23]..[45,1427+26]) [ Nolabel - expression (test_locations.ml[44,1388+27]..[44,1388+34]) + expression (test_locations.ml[45,1427+27]..[45,1427+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[45,1427+30]..[45,1427+31]) + Pexp_ident "-" (test_locations.ml[45,1427+30]..[45,1427+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[45,1427+28]..[45,1427+29]) + Pexp_ident "n" (test_locations.ml[45,1427+28]..[45,1427+29]) Nolabel - expression (test_locations.ml[44,1388+32]..[44,1388+33]) + expression (test_locations.ml[45,1427+32]..[45,1427+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[43,1389+0]..test_locations.ml[45,1427+34]) Tstr_value Rec [ - pattern (test_locations.ml[42,1350+8]..test_locations.ml[42,1350+11]) + pattern (test_locations.ml[43,1389+8]..test_locations.ml[43,1389+11]) Tpat_var "fib" - expression (test_locations.ml[42,1350+14]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[43,1389+14]..test_locations.ml[45,1427+34]) Texp_function Nolabel [ - pattern (test_locations.ml[43,1373+4]..test_locations.ml[43,1373+9]) + pattern (test_locations.ml[44,1412+4]..test_locations.ml[44,1412+9]) Tpat_or - pattern (test_locations.ml[43,1373+4]..test_locations.ml[43,1373+5]) + pattern (test_locations.ml[44,1412+4]..test_locations.ml[44,1412+5]) Tpat_constant Const_int 0 - pattern (test_locations.ml[43,1373+8]..test_locations.ml[43,1373+9]) + pattern (test_locations.ml[44,1412+8]..test_locations.ml[44,1412+9]) Tpat_constant Const_int 1 - expression (test_locations.ml[43,1373+13]..test_locations.ml[43,1373+14]) + expression (test_locations.ml[44,1412+13]..test_locations.ml[44,1412+14]) Texp_constant Const_int 1 - pattern (test_locations.ml[44,1388+4]..test_locations.ml[44,1388+5]) + pattern (test_locations.ml[45,1427+4]..test_locations.ml[45,1427+5]) Tpat_var "n" - expression (test_locations.ml[44,1388+9]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[45,1427+9]..test_locations.ml[45,1427+34]) Texp_apply - expression (test_locations.ml[44,1388+21]..test_locations.ml[44,1388+22]) + expression (test_locations.ml[45,1427+21]..test_locations.ml[45,1427+22]) Texp_ident "Stdlib!.+" [ Nolabel - expression (test_locations.ml[44,1388+9]..test_locations.ml[44,1388+20]) + expression (test_locations.ml[45,1427+9]..test_locations.ml[45,1427+20]) Texp_apply - expression (test_locations.ml[44,1388+9]..test_locations.ml[44,1388+12]) + expression (test_locations.ml[45,1427+9]..test_locations.ml[45,1427+12]) Texp_ident "fib" [ Nolabel - expression (test_locations.ml[44,1388+13]..test_locations.ml[44,1388+20]) + expression (test_locations.ml[45,1427+13]..test_locations.ml[45,1427+20]) Texp_apply - expression (test_locations.ml[44,1388+16]..test_locations.ml[44,1388+17]) + expression (test_locations.ml[45,1427+16]..test_locations.ml[45,1427+17]) Texp_ident "Stdlib!.-" [ Nolabel - expression (test_locations.ml[44,1388+14]..test_locations.ml[44,1388+15]) + expression (test_locations.ml[45,1427+14]..test_locations.ml[45,1427+15]) Texp_ident "n" Nolabel - expression (test_locations.ml[44,1388+18]..test_locations.ml[44,1388+19]) + expression (test_locations.ml[45,1427+18]..test_locations.ml[45,1427+19]) Texp_constant Const_int 1 ] ] Nolabel - expression (test_locations.ml[44,1388+23]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[45,1427+23]..test_locations.ml[45,1427+34]) Texp_apply - expression (test_locations.ml[44,1388+23]..test_locations.ml[44,1388+26]) + expression (test_locations.ml[45,1427+23]..test_locations.ml[45,1427+26]) Texp_ident "fib" [ Nolabel - expression (test_locations.ml[44,1388+27]..test_locations.ml[44,1388+34]) + expression (test_locations.ml[45,1427+27]..test_locations.ml[45,1427+34]) Texp_apply - expression (test_locations.ml[44,1388+30]..test_locations.ml[44,1388+31]) + expression (test_locations.ml[45,1427+30]..test_locations.ml[45,1427+31]) Texp_ident "Stdlib!.-" [ Nolabel - expression (test_locations.ml[44,1388+28]..test_locations.ml[44,1388+29]) + expression (test_locations.ml[45,1427+28]..test_locations.ml[45,1427+29]) Texp_ident "n" Nolabel - expression (test_locations.ml[44,1388+32]..test_locations.ml[44,1388+33]) + expression (test_locations.ml[45,1427+32]..test_locations.ml[45,1427+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(43):1403-1461 (if (isout 1 n) - (before Test_locations.fib test_locations.ml(44):1397-1422 + (before Test_locations.fib test_locations.ml(45):1436-1461 (+ - (after Test_locations.fib test_locations.ml(44):1397-1408 + (after Test_locations.fib test_locations.ml(45):1436-1447 (apply fib (- n 1))) - (after Test_locations.fib test_locations.ml(44):1411-1422 + (after Test_locations.fib test_locations.ml(45):1450-1461 (apply fib (- n 2))))) - (before Test_locations.fib test_locations.ml(43):1386-1387 1))))) + (before Test_locations.fib test_locations.ml(44):1425-1426 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 index 53054491e..ff9f5fa82 100644 --- a/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference +++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference @@ -12,13 +12,13 @@ cmm: "camlTest_locations__gc_roots": addr "camlTest_locations" int 0) -(function{test_locations.ml:42,14-72} camlTest_locations__fib_81 (n: val) +(function{test_locations.ml:43,14-72} camlTest_locations__fib_81 (n: val) (if ( Date: Tue, 28 Jul 2020 17:44:59 +0200 Subject: [PATCH 065/160] Build system: honour the CFLAGS and CPPFLAGS build variables With this commit, it becomes possible to provide C compiler and preprocessor flags to use in addition to those defined by the build system. As required by the GNU coding standards, the flags can be provided either at configure or at make invocation. The provided CFLAGS and CPPFLAGS will also be taken into account when C code is compiled by ocamlc/ocamlopt. This commit removes the explicit reference to CFLAGS in the configuration for the xlc compiler, since it is not necessary any longer. --- Changes | 3 +++ Makefile | 13 ++++++++----- Makefile.common | 3 ++- Makefile.config.in | 6 ++++-- configure | 13 +++++++++---- configure.ac | 13 +++++++++---- ocamltest/Makefile | 2 +- otherlibs/Makefile.otherlibs.common | 2 +- otherlibs/systhreads/Makefile | 5 +++-- runtime/Makefile | 6 ++++-- stdlib/Makefile | 5 +++-- 11 files changed, 47 insertions(+), 24 deletions(-) diff --git a/Changes b/Changes index afd48b6b0..fa081b4f0 100644 --- a/Changes +++ b/Changes @@ -318,6 +318,9 @@ Working version - #9804: Build C stubs of libraries in otherlibs/ with debug info. (Stephen Dolan, review by Sébastien Hinderer and David Allsopp) +- #9824: 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 diff --git a/Makefile b/Makefile index 4455a6fd1..5834f965d 100644 --- a/Makefile +++ b/Makefile @@ -927,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 3228a5a6f..8e6b23a54 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -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) $(OUTPUTEXE)$(1) $(2) \ /link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE)) else - MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2) + MKEXE_BOOT=$(CC) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2) endif # ifeq "$(TOOLCHAIN)" "msvc" # The following variables were defined only in the Windows-specific makefiles. diff --git a/configure b/configure index f42320dda..f2093ae23 100755 --- a/configure +++ b/configure @@ -2780,7 +2780,7 @@ programs_man_section=1 libraries_man_section=3 # Command to build executalbes -mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)" +mkexe="\$(CC) \$(OC_LDFLAGS)" # Flags for building executable files with debugging symbols mkexedebugflag="-g" @@ -3460,10 +3460,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 @@ -12309,6 +12313,7 @@ CC=$lt_save_CC # Only expand once: +CFLAGS="$saved_CFLAGS" host_os=$old_host_os case $host in #( @@ -12727,7 +12732,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" ;; @@ -16980,8 +16985,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 c4957c25d..d5eae8153 100644 --- a/configure.ac +++ b/configure.ac @@ -37,7 +37,7 @@ programs_man_section=1 libraries_man_section=3 # Command to build executalbes -mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)" +mkexe="\$(CC) \$(OC_LDFLAGS)" # Flags for building executable files with debugging symbols mkexedebugflag="-g" @@ -406,9 +406,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 +633,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"])]) @@ -1851,8 +1856,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/ocamltest/Makefile b/ocamltest/Makefile index a7cecf08a..c803bb7ae 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -304,7 +304,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/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common index 781db8e75..a029af560 100644 --- a/otherlibs/Makefile.otherlibs.common +++ b/otherlibs/Makefile.otherlibs.common @@ -144,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 fb2740bc2..2afa345a0 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -100,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* @@ -162,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/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/stdlib/Makefile b/stdlib/Makefile index 9fbc01986..47c90266a 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -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)$@ $^ From 7c0623b33e39af5f6ed7300b480ec19ef3364b40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 3 Aug 2020 16:56:51 +0200 Subject: [PATCH 066/160] Simplify the tools/ci/inria/extra-checks script Use the ability to pass flags to the C compiler at configure time to simplify this CI script. Looking at the diff, it may seem that some flags like -fwrapv, -fno-strict-aliasing, -Wall and -Werror got lost by this commit. It is actually not the case. In its previous version, this script was overriding the flags as defined by the compiler's build system, so it had to provide a rather exhaustive list of flags. Now one only needs to add the flags specific to the build one wishes to do. The flags mentionned above* are provided by the compiler's build system so they do not need to be mentionned here any longer. --- tools/ci/inria/extra-checks | 50 ++++++++++++------------------------- 1 file changed, 16 insertions(+), 34 deletions(-) diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index 1a9663839..fc929d46d 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -48,16 +48,6 @@ arch_error() { 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} -} - ######################################################################### # Print each command before its execution @@ -151,10 +141,6 @@ 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 @@ -172,12 +158,14 @@ 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 @@ -205,14 +193,13 @@ 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 @@ -234,20 +221,15 @@ 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" +# ./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 From 478127ff437554a6aae1d11aa7855c349a49e56e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 10 Aug 2020 13:52:47 +0200 Subject: [PATCH 067/160] Build system: use OC_CFLAGS and CFLAGS even during the link stage --- Changes | 2 +- Makefile.config.in | 4 ++-- configure | 6 +++++- configure.ac | 6 +++++- 4 files changed, 13 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index 52861c1ab..245d84724 100644 --- a/Changes +++ b/Changes @@ -328,7 +328,7 @@ Working version - #9804: Build C stubs of libraries in otherlibs/ with debug info. (Stephen Dolan, review by Sébastien Hinderer and David Allsopp) -- #9824: Honour the CFLAGS and CPPFLAGS variables. +- #9824, #9837: Honour the CFLAGS and CPPFLAGS variables. (Sébastien Hinderer, review by David Allsopp) ### Bug fixes: diff --git a/Makefile.config.in b/Makefile.config.in index 8e6b23a54..26741a5b2 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -254,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) $(OUTPUTEXE)$(1) $(2) \ + MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) \ /link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE)) else - MKEXE_BOOT=$(CC) $(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/configure b/configure index f2093ae23..0638afb45 100755 --- a/configure +++ b/configure @@ -2780,7 +2780,11 @@ programs_man_section=1 libraries_man_section=3 # Command to build executalbes -mkexe="\$(CC) \$(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" diff --git a/configure.ac b/configure.ac index d5eae8153..1bab4b31e 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_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" From bc62faec7b6ad50378660cd93e16484d5e3fe8a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 10 Aug 2020 15:08:57 +0200 Subject: [PATCH 068/160] Introduce the check-typo Jenkins pipeline --- tools/ci/inria/README.md | 13 ++++++++ tools/ci/inria/check-typo/Jenkinsfile | 47 +++++++++++++++++++++++++++ tools/ci/inria/extra-checks | 6 ---- 3 files changed, 60 insertions(+), 6 deletions(-) create mode 100644 tools/ci/inria/README.md create mode 100644 tools/ci/inria/check-typo/Jenkinsfile diff --git a/tools/ci/inria/README.md b/tools/ci/inria/README.md new file mode 100644 index 000000000..4e4535479 --- /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/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/extra-checks b/tools/ci/inria/extra-checks index fc929d46d..7997dd037 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -111,12 +111,6 @@ 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 ==========" From a59b147f516050b50fbeb4d55403b94c74bd6da3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 10 Aug 2020 15:52:40 +0200 Subject: [PATCH 069/160] Inria CI: define the dune-build job as a Jenkins pipeline --- tools/ci/inria/dune-build/Jenkinsfile | 41 +++++++++++++++++++ .../inria/{dune-build => dune-build/script} | 0 2 files changed, 41 insertions(+) create mode 100644 tools/ci/inria/dune-build/Jenkinsfile rename tools/ci/inria/{dune-build => dune-build/script} (100%) 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 From 13a500f3dd773b3c795c1c097b71caa24d1daecc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 09:19:57 +0200 Subject: [PATCH 070/160] tools/ci/inria/README.md: typographical improvements --- tools/ci/inria/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/ci/inria/README.md b/tools/ci/inria/README.md index 4e4535479..8ade11237 100644 --- a/tools/ci/inria/README.md +++ b/tools/ci/inria/README.md @@ -2,9 +2,9 @@ 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 +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 +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 From 756f6393bf6a5a2bef646af78045a1382416e32d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 10:38:27 +0200 Subject: [PATCH 071/160] Always report failures of Inria CI's dune-build job For the time being, let's report all the failures of this job and not only its regressions. --- tools/ci/inria/dune-build/Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/dune-build/Jenkinsfile b/tools/ci/inria/dune-build/Jenkinsfile index a53a641b4..290cf5fb2 100644 --- a/tools/ci/inria/dune-build/Jenkinsfile +++ b/tools/ci/inria/dune-build/Jenkinsfile @@ -25,7 +25,7 @@ pipeline { } } post { - regression { + failure { emailext ( to: 'Sebastien.Hinderer@inria.fr, thomas.refis@gmail.com', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', From eacd3c3bc531e7fe0b8223baff47b17713486978 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Tue, 11 Aug 2020 14:34:50 +0200 Subject: [PATCH 072/160] Release info: ocaml-src and ocaml-manual --- release-info/howto.md | 3 +++ 1 file changed, 3 insertions(+) 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. From 697242f4b2ae91ca40ab6ee1ea5327bb8fec6d1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 14:49:38 +0200 Subject: [PATCH 073/160] dune-build: send e-mails only for regressions --- tools/ci/inria/dune-build/Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/dune-build/Jenkinsfile b/tools/ci/inria/dune-build/Jenkinsfile index 290cf5fb2..a53a641b4 100644 --- a/tools/ci/inria/dune-build/Jenkinsfile +++ b/tools/ci/inria/dune-build/Jenkinsfile @@ -25,7 +25,7 @@ pipeline { } } post { - failure { + regression { emailext ( to: 'Sebastien.Hinderer@inria.fr, thomas.refis@gmail.com', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', From c89c464746709f8373dc7e7a57e8200d79f64e50 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 16:03:27 +0200 Subject: [PATCH 074/160] Split Inria CI's extra-checks job, take #1 This job did actually do two different things: 1. Check that the compiler can be built without the world.opt target 2. Run sanitizers This commit thus splits the extra-checks job into two separate ones that are defined as Jenkins pipeline jobs named sanitizers and step-by-step-build. --- tools/ci/inria/sanitizers/Jenkinsfile | 41 ++++++++++ .../ci/inria/{ => sanitizers}/lsan-suppr.txt | 0 .../inria/{extra-checks => sanitizers/script} | 82 +------------------ tools/ci/inria/step-by-step-build/Jenkinsfile | 44 ++++++++++ tools/ci/inria/step-by-step-build/script | 26 ++++++ 5 files changed, 114 insertions(+), 79 deletions(-) create mode 100644 tools/ci/inria/sanitizers/Jenkinsfile rename tools/ci/inria/{ => sanitizers}/lsan-suppr.txt (100%) rename tools/ci/inria/{extra-checks => sanitizers/script} (72%) create mode 100644 tools/ci/inria/step-by-step-build/Jenkinsfile create mode 100755 tools/ci/inria/step-by-step-build/script diff --git a/tools/ci/inria/sanitizers/Jenkinsfile b/tools/ci/inria/sanitizers/Jenkinsfile new file mode 100644 index 000000000..77dc0e140 --- /dev/null +++ b/tools/ci/inria/sanitizers/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 sanitizers job on Inria's CI */ + +pipeline { + agent { label 'ocaml-linux-64' } + stages { + stage('Compiling and testing OCaml with sanitizers') { + steps { + sh 'tools/ci/inria/sanitizers/script' + } + } + } + post { + always { + 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 72% rename from tools/ci/inria/extra-checks rename to tools/ci/inria/sanitizers/script index 7997dd037..5f8e5b6e7 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/sanitizers/script @@ -24,29 +24,8 @@ 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" -} +jobs=-j8 +make=make ######################################################################### @@ -56,39 +35,6 @@ 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 @@ -108,28 +54,6 @@ export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH" ######################################################################### -# Cleanup repository -git clean -q -f -d -x - -######################################################################### - -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 @@ -166,7 +90,7 @@ sanitizers="-fsanitize=address -fsanitize-trap=$ubsan" # 2- add an exception for ocamlyacc, which doesn't free memory OCAMLRUNPARAM="c=1" \ -LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/lsan-suppr.txt" \ +LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/sanitizers/lsan-suppr.txt" \ make $jobs # Run the 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..b2b0d499d --- /dev/null +++ b/tools/ci/inria/step-by-step-build/Jenkinsfile @@ -0,0 +1,44 @@ +/**************************************************************************/ +/* */ +/* 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 the world.opt target)') { + steps { + sh 'tools/ci/inria/step-by-step-build/script' + } + } + } + post { + always { + 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..52d498d6f --- /dev/null +++ b/tools/ci/inria/step-by-step-build/script @@ -0,0 +1,26 @@ +#!/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=8 +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 + ''' From 541ade530f96f30b43ab75341304f31ec72cf3f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 16:51:35 +0200 Subject: [PATCH 075/160] Split the extra-checks job, take #2 --- tools/ci/inria/step-by-step-build/Jenkinsfile | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tools/ci/inria/step-by-step-build/Jenkinsfile b/tools/ci/inria/step-by-step-build/Jenkinsfile index b2b0d499d..b4a9a8f7e 100644 --- a/tools/ci/inria/step-by-step-build/Jenkinsfile +++ b/tools/ci/inria/step-by-step-build/Jenkinsfile @@ -20,8 +20,9 @@ pipeline { agent { label 'ocaml-linux-64' } stages { - stage('Building the OCaml compiler step by step ' + - + '(without using the world.opt target)') { + stage( + 'Building the OCaml compiler step by step (without using world.opt)' + ) { steps { sh 'tools/ci/inria/step-by-step-build/script' } From 5acc76eb0775c9617bd72377b5fffcb6a87f37d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 16:57:34 +0200 Subject: [PATCH 076/160] tools/ci/inria/step-by-step-build/script: fixes --- tools/ci/inria/step-by-step-build/script | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tools/ci/inria/step-by-step-build/script b/tools/ci/inria/step-by-step-build/script index 52d498d6f..8397e6836 100755 --- a/tools/ci/inria/step-by-step-build/script +++ b/tools/ci/inria/step-by-step-build/script @@ -14,7 +14,7 @@ #* * #************************************************************************** -jobs=8 +jobs=-j8 instdir="$HOME/ocaml-tmp-install-$$" ./configure --prefix "$instdir" --disable-dependency-generation make $jobs world @@ -23,4 +23,3 @@ make $jobs opt.opt make install rm -rf "$instdir" # It's a build system test only, so we don't bother testing the compiler - ''' From a12bf04282cbcd99def6e3d217c3fd3b9a30d886 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 17:47:50 +0200 Subject: [PATCH 077/160] Make the sanitizers and step-by-step-build CI jobs less verbose Now that these jobs work, make them report only regressions --- tools/ci/inria/sanitizers/Jenkinsfile | 2 +- tools/ci/inria/step-by-step-build/Jenkinsfile | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/ci/inria/sanitizers/Jenkinsfile b/tools/ci/inria/sanitizers/Jenkinsfile index 77dc0e140..7add2f2f2 100644 --- a/tools/ci/inria/sanitizers/Jenkinsfile +++ b/tools/ci/inria/sanitizers/Jenkinsfile @@ -25,7 +25,7 @@ pipeline { } } post { - always { + regression { emailext ( to: 'ocaml-ci-notifications@inria.fr', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', diff --git a/tools/ci/inria/step-by-step-build/Jenkinsfile b/tools/ci/inria/step-by-step-build/Jenkinsfile index b4a9a8f7e..eb020c656 100644 --- a/tools/ci/inria/step-by-step-build/Jenkinsfile +++ b/tools/ci/inria/step-by-step-build/Jenkinsfile @@ -29,7 +29,7 @@ pipeline { } } post { - always { + regression { emailext ( to: 'ocaml-ci-notifications@inria.fr', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', From 34a074f2752e181caed32e922f490af351829e0b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 17:41:28 +0200 Subject: [PATCH 078/160] Changes: minor fixes backported from 4.10 --- Changes | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index 245d84724..5ff5d9cbc 100644 --- a/Changes +++ b/Changes @@ -945,7 +945,7 @@ OCaml 4.10 maintenance branch - #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) OCaml 4.10.0 (21 February 2020) ------------------------------- @@ -1488,15 +1488,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 From d61527df10cd51a3a06888aa9438460b3392f99e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 17:49:52 +0200 Subject: [PATCH 079/160] Changes: #9349 entry was misplaced --- Changes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 5ff5d9cbc..f1fa1e8ca 100644 --- a/Changes +++ b/Changes @@ -705,6 +705,9 @@ OCaml 4.11 from intermediate-representation dumps (-dfoo). (Gabriel Scherer, review by Vincent Laviron) +- #9349: Support [@inlined hint] attribute. + (Leo White, review by Stephen Dolan) + - #9393: Improve recursive module usage warnings (Leo White, review by Thomas Refis) @@ -2972,9 +2975,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 From 15bcfa2ae7d8075789db8a8c017981d5dc58f0d1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 17:51:16 +0200 Subject: [PATCH 080/160] Changes: some part of #9724 went into 4.10.1 --- Changes | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index f1fa1e8ca..5bfb39333 100644 --- a/Changes +++ b/Changes @@ -361,10 +361,8 @@ 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. +- #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) - #9759, #9767: Spurious GADT ambiguity without -principal @@ -946,6 +944,10 @@ 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 and review by Leo White) From a459c5f8d927873d22231324794d283bdb68b898 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 17:53:33 +0200 Subject: [PATCH 081/160] Changes: #9552 went into 4.10.1 --- Changes | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 5bfb39333..c86d425d9 100644 --- a/Changes +++ b/Changes @@ -631,9 +631,6 @@ OCaml 4.11 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 @@ -952,6 +949,11 @@ OCaml 4.10 maintenance branch blue, which was not the case with the best-fit allocator. (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) ------------------------------- From 0c62a438911d1ef342e794af555f864d610128dd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 17:56:57 +0200 Subject: [PATCH 082/160] Changes: #9422 went into 4.11 --- Changes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index c86d425d9..076790316 100644 --- a/Changes +++ b/Changes @@ -654,6 +654,9 @@ OCaml 4.11 warnings for consistency. (Muskan Garg, review by Gabriel Scherer and Florian Angeletti) +- #9410, #9422: replaced naive fibonacci example with gcd + (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès) + - #7708, #9580: Ensure Stdlib documentation index refers to Stdlib. (Stephen Dolan, review by Florian Angeletti, report by Hannes Mehnert) @@ -2250,9 +2253,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. From fc3a8ef00ef3066bf0e178fdcf66542609bb7b2d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 17:59:34 +0200 Subject: [PATCH 083/160] Changes: #9275 went into 4.11 --- Changes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 076790316..57cc27440 100644 --- a/Changes +++ b/Changes @@ -772,6 +772,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) @@ -1728,9 +1731,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 From 625f4f6f236527d467754315e9de0b7a527b1d80 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 18:01:35 +0200 Subject: [PATCH 084/160] Changes: #9401 went into 4.11 --- Changes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 57cc27440..738ac7d78 100644 --- a/Changes +++ b/Changes @@ -650,6 +650,9 @@ OCaml 4.11 - #9325: documented base case for `List.for_all` and `List.exists` (Glenn Slotte, review by Florian Angeletti) +- #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) @@ -1657,9 +1660,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 From d0da7e707984d74ab704a5d785100540e5f82ed7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 18:11:53 +0200 Subject: [PATCH 085/160] Changes: #9181 went into 4.10.1 --- Changes | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index 738ac7d78..706bd8430 100644 --- a/Changes +++ b/Changes @@ -595,10 +595,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 @@ -1271,6 +1267,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 From 0ec62d1dfdfb75beff040b934a399e7c9651c6dc Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 18:40:09 +0200 Subject: [PATCH 086/160] Changes: #9389 was merged in 4.11 --- Changes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 706bd8430..007e48076 100644 --- a/Changes +++ b/Changes @@ -892,6 +892,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 @@ -1471,9 +1474,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 ----------------------------- From 2a2e425b5019e5f4b2e1b887069f1054f6f19d87 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 22:17:59 +0200 Subject: [PATCH 087/160] Changes: the rest of #9724 went into 4.11, not 4.12+dev --- Changes | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index 007e48076..4b614ecd6 100644 --- a/Changes +++ b/Changes @@ -361,10 +361,6 @@ Working version (Xavier Leroy, Sadiq Jaffer, Gabriel Scherer, review by Xavier Leroy and Jacques-Henri Jourdan) -- #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) - - #9759, #9767: Spurious GADT ambiguity without -principal (Jacques Garrigue, report by Thomas Refis, review by Thomas Refis and Gabriel Scherer) @@ -920,6 +916,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 ----------------------------- From 42b9d66ec9849304b0c9e3562ac435e16eb5c4b3 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 22:23:41 +0200 Subject: [PATCH 088/160] Changes: #9464 is in 4.12, not 4.11 --- Changes | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 4b614ecd6..d5f981002 100644 --- a/Changes +++ b/Changes @@ -267,7 +267,7 @@ Working version - #9216: add Lambda.duplicate which refreshes bound identifiers (Gabriel Scherer, review by Pierre Chambart and Vincent Laviron) -- #9493, #9520, #9563, #9599, #9608, #9647: refactor +- #9464, #9493, #9520, #9563, #9599, #9608, #9647: refactor the pattern-matching compiler (Thomas Refis and Gabriel Scherer, review by Florian Angeletti) @@ -759,7 +759,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) From f89356b89cbb0a2fdce4fd991f72ba499dd32295 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 22:25:44 +0200 Subject: [PATCH 089/160] Changes: #9795 is in 4.12, not 4.11 --- Changes | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index d5f981002..a5e5f06d1 100644 --- a/Changes +++ b/Changes @@ -220,6 +220,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 @@ -568,10 +572,6 @@ 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) - - #6969: Argument -nocwd added to ocamldep (Muskan Garg, review by Florian Angeletti) From 07ddbe22ebf0d52fdb353bf9fcc788a62d01d4a1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 22:27:03 +0200 Subject: [PATCH 090/160] Changes: #9790 is in 4.12, not 4.11 --- Changes | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index a5e5f06d1..3648b26ef 100644 --- a/Changes +++ b/Changes @@ -205,6 +205,10 @@ 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) @@ -549,10 +553,6 @@ OCaml 4.11 ### 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) From 68218d1906cf58b5606e739e2612a88a6efc90a5 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 11 Aug 2020 22:58:51 +0200 Subject: [PATCH 091/160] Changes: reorder 4.11 Changes entries --- Changes | 255 ++++++++++++++++++++++++++++++-------------------------- 1 file changed, 136 insertions(+), 119 deletions(-) diff --git a/Changes b/Changes index 3648b26ef..77dee34ba 100644 --- a/Changes +++ b/Changes @@ -385,40 +385,29 @@ OCaml 4.11 (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 @@ -428,12 +417,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) @@ -450,11 +447,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) @@ -462,12 +454,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) @@ -480,40 +466,36 @@ 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) ### 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) @@ -521,11 +503,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) @@ -533,6 +510,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) @@ -540,17 +529,10 @@ 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: - #9106: Register printer for Unix_error in win32unix, as in unix. @@ -570,8 +552,43 @@ OCaml 4.11 (Xavier Leroy and Guillaume Melquiond, report by David Brown, review by Gabriel Scherer and David Allsopp) +### 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) + ### Tools: +- #9283, #9455, #9457: add a new toplevel directive `#use_output ""` to + run a command and evaluate its output. + (Jérémie Dimino, review by David Allsopp) + + - #6969: Argument -nocwd added to ocamldep (Muskan Garg, review by Florian Angeletti) @@ -608,26 +625,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) ### 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) @@ -642,19 +645,9 @@ OCaml 4.11 - #9325: documented base case for `List.for_all` and `List.exists` (Glenn Slotte, review by Florian Angeletti) -- #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) - - #9410, #9422: replaced naive fibonacci example with gcd (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès) -- #7708, #9580: Ensure Stdlib documentation index refers to Stdlib. - (Stephen Dolan, review by Florian Angeletti, report by Hannes Mehnert) - - #9541: Add a documentation page for the instrumented runtime; additional changes to option names in the instrumented runtime. (Enguerrand Decorne, review by Anil Madhavapeddy, Gabriel Scherer, @@ -669,12 +662,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). @@ -698,31 +720,24 @@ OCaml 4.11 from intermediate-representation dumps (-dfoo). (Gabriel Scherer, review by Vincent Laviron) -- #9349: Support [@inlined hint] attribute. - (Leo White, review by Stephen Dolan) - - #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 @@ -741,9 +756,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) @@ -783,11 +795,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: @@ -916,7 +933,7 @@ 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 +- #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) From d0d8acecb0024aadffe596b169826b5d16ca53f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 11 Aug 2020 18:12:51 +0200 Subject: [PATCH 092/160] Use a pipeline to define the bootstrap Jenkins job, take #1 --- tools/ci/inria/bootstrap/Jenkinsfile | 43 +++++++++++++++++++ .../remove-sinh-primitive.patch | 0 .../ci/inria/{bootstrap => bootstrap/script} | 2 +- 3 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 tools/ci/inria/bootstrap/Jenkinsfile rename tools/ci/inria/{ => bootstrap}/remove-sinh-primitive.patch (100%) rename tools/ci/inria/{bootstrap => bootstrap/script} (99%) diff --git a/tools/ci/inria/bootstrap/Jenkinsfile b/tools/ci/inria/bootstrap/Jenkinsfile new file mode 100644 index 000000000..5602c930f --- /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 { + always { + 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 } ######################################################################### From 2f16b98a8d4f2359cdab0d56c2338f6c51b3598a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 13 Aug 2020 14:17:53 +0200 Subject: [PATCH 093/160] Notify only on regressions for Inria CI's bootstrap job --- tools/ci/inria/bootstrap/Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/bootstrap/Jenkinsfile b/tools/ci/inria/bootstrap/Jenkinsfile index 5602c930f..4f1f5a98c 100644 --- a/tools/ci/inria/bootstrap/Jenkinsfile +++ b/tools/ci/inria/bootstrap/Jenkinsfile @@ -27,7 +27,7 @@ pipeline { } } post { - always { + regression { emailext ( to: 'ocaml-ci-notifications@inria.fr', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', From 5cdc8072bebeb4a0c8c49802ca24373adab2a758 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 13 Aug 2020 14:44:06 +0200 Subject: [PATCH 094/160] Define Inria CI's Risc-V job as a Jenkins pipeline, take #1 --- tools/ci/inria/Risc-V/Jenkinsfile | 42 +++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 tools/ci/inria/Risc-V/Jenkinsfile diff --git a/tools/ci/inria/Risc-V/Jenkinsfile b/tools/ci/inria/Risc-V/Jenkinsfile new file mode 100644 index 000000000..3cbf9e288 --- /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 { + always { + 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 + ) + } + } +} From e05fc92d1279cc747fd939f43b27e767755101f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 13 Aug 2020 19:08:07 +0200 Subject: [PATCH 095/160] Notify only on regressions for Inria CI's Risc-V job --- tools/ci/inria/Risc-V/Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/Risc-V/Jenkinsfile b/tools/ci/inria/Risc-V/Jenkinsfile index 3cbf9e288..4221adc37 100644 --- a/tools/ci/inria/Risc-V/Jenkinsfile +++ b/tools/ci/inria/Risc-V/Jenkinsfile @@ -26,7 +26,7 @@ pipeline { } } post { - always { + regression { emailext ( to: 'ocaml-ci-notifications@inria.fr', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', From b1ffaf6008d6bb72dac86cc1cf40e230e2e8b782 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Fri, 14 Aug 2020 14:39:33 +0200 Subject: [PATCH 096/160] Define Inria CI's other-configs job as a Jenkins pipeline, take #1 --- tools/ci/inria/other-configs/Jenkinsfile | 43 +++++++++++++++++++ .../{other-configs => other-configs/script} | 0 2 files changed, 43 insertions(+) create mode 100644 tools/ci/inria/other-configs/Jenkinsfile rename tools/ci/inria/{other-configs => other-configs/script} (100%) diff --git a/tools/ci/inria/other-configs/Jenkinsfile b/tools/ci/inria/other-configs/Jenkinsfile new file mode 100644 index 000000000..c468ab093 --- /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 { + always { + 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 From 7b2689b8a06bac25821a4ed9adecc659b74c68c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Fri, 14 Aug 2020 15:50:25 +0200 Subject: [PATCH 097/160] Define Inria CI's other-configs job as a Jenkins pipeline, take #2 --- tools/ci/inria/other-configs/Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/other-configs/Jenkinsfile b/tools/ci/inria/other-configs/Jenkinsfile index c468ab093..bacf7d836 100644 --- a/tools/ci/inria/other-configs/Jenkinsfile +++ b/tools/ci/inria/other-configs/Jenkinsfile @@ -20,7 +20,7 @@ pipeline { agent { label 'ocaml-linux-64' } stages { - stage('Testing various other compiler configurations') + stage('Testing various other compiler configurations') { steps { sh 'tools/ci/inria/other-configs/script' } From d9a3ad413f9567c418cf7809a110fac5fcd36f6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Fri, 14 Aug 2020 17:01:58 +0200 Subject: [PATCH 098/160] Notify only on regressions for Inria CI's other-configs job --- tools/ci/inria/other-configs/Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/ci/inria/other-configs/Jenkinsfile b/tools/ci/inria/other-configs/Jenkinsfile index bacf7d836..75b8f6009 100644 --- a/tools/ci/inria/other-configs/Jenkinsfile +++ b/tools/ci/inria/other-configs/Jenkinsfile @@ -27,7 +27,7 @@ pipeline { } } post { - always { + regression { emailext ( to: 'ocaml-ci-notifications@inria.fr', subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)', From 49aa87c316c441aa47974e8e9191a5a7e6d03d9a Mon Sep 17 00:00:00 2001 From: hhugo Date: Mon, 17 Aug 2020 10:47:36 +0200 Subject: [PATCH 099/160] Introduce warning 68 to warn about hidden allocation due to pattern match of mutable field in curried functions (#9751) Introduce new warning 68 --- Changes | 4 + boot/ocamlc | Bin 2792579 -> 2796371 bytes boot/ocamllex | Bin 345305 -> 345305 bytes debugger/time_travel.ml | 2 +- lambda/translcore.ml | 102 +++++++++++------- man/ocamlc.m | 6 +- .../tests/warnings/w68.compilers.reference | 11 ++ testsuite/tests/warnings/w68.ml | 34 ++++++ testsuite/tests/warnings/w68.reference | 2 + utils/warnings.ml | 13 ++- utils/warnings.mli | 1 + 11 files changed, 134 insertions(+), 41 deletions(-) create mode 100644 testsuite/tests/warnings/w68.compilers.reference create mode 100644 testsuite/tests/warnings/w68.ml create mode 100644 testsuite/tests/warnings/w68.reference diff --git a/Changes b/Changes index 77dee34ba..659e1e42c 100644 --- a/Changes +++ b/Changes @@ -270,6 +270,10 @@ 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 diff --git a/boot/ocamlc b/boot/ocamlc index 6bcfb63466f8167baab639019f928baab9f6aee1..8a1e287b12996873f2983bf066f50443dab0d9c3 100755 GIT binary patch delta 156494 zcmbTf3w%vS*9UA)&OUqZbM`(tNA41GA|W9`;!;sTg1S^xQWQlcMMVYipyfd&rLER2 zX~?2zqbORJM6s#Rr0#V~iqe)kdZm>%Y4s^Z^ZjS<6HdL)`+e{4^D}4m%&eJNvu4ej zHES-JxA%Q^_Vf2y?tC`iG~Z{wd8bgk)6`C-NhQHeX+|GK5guvKpuu!va=+SV{l`Ia&`&v?BBF@mk`Tl(WzZRH#S>ScMAg;n?oZtA)LKLb2MQp z&7N*nC?nj*%)*zKs(w`7-&diiJ%WRU5t}diQAU!#nH+sgW}yjcw@|?avmedaBg9eJ z5g!MYoNg#lahNaaoz+yLWELDuVV%MqlzhZ4>BN{z zwMPZN5Z)+1I1?OiEN^&gI2UDp=<=Hz*q~K|9tie^>jyUgZXnzcxZ!Z4;6}rZgPQ<1 z8Ez`vi*U2x=EA)Sw*>A@xFWc>;NFIN7j8e?Z*VP8cUQP4;0oY2!f6cIEAVjwt`hDF zdVxDPzHh<_Kso@f8C(ar$KVFTEr$CPF3P7tg9UIa;5NbSg8KyS4BRESzu*E;UQ@U@ zxJTfU;d0^LfP2gAXwYB-K6b%<40py%zwH%13Wx#5sJ}r6xJ8K9!*uy0A(pm$B!sbi zN;nPoJsECP?fZ zavm0;)J1&@wmbmu|@#+W2#|I{d-$IQK2%*lc z523M*H!GZS4ha(F91zU%b^vhr5=uED1W|mgU7`HuW{H)0p|?Xvk8(d2jIprOAkHoW zr`-llni1MVc^`u&d&&iWD);x1sB*ucQ02#hKl{i4+{a7q$I7Sxq@|2A_u|=PtvyK@t$32bsL~yZB^(YEHh~9UU zgK+tupgAYeeou#-y5C}O#=2mMT>Bz}DQ#UNiEb!Oq{gQKItZk~D9}0i48rx~t~6w1 zeoM1IB_9-mg(@Vfg?W$pQO-fZU--;BXr|(Wp#QN$^_T!eqMF+wW~zA_%$U;&ym_Nf zghcLxLK-_q35Ott&l^=_90Id_j^gaJ_b}wC-dSH5sPh)FFF8{d()=SRJ?)5~uuDd7 zT{iNU`1|;i;|PfUHSh9Jc12Gn*HLtsUcgm@8NV?|_^mq z6T)cdaluh^jCa^c{G2?7HvVd~*KrinNZNcS=!VJ~)}XBVal=JTt-0XsK#GsVbnzRP zFwyLH!@Eg&$A!u452`&b1hN0^%|^82B-lrI5N+Ynotdc3IVpT=p{&mZ7v-J>ZZZ{|MQg0I`K&NXupvhl zCHR^AAmzX@3c}-!aQRswm~NZ}IwimROH|%896zsu<%-Xtte90k3Y|O$66jyo?thuj z3t8kEi-|Eit}$lO>wc0`0+l2GuB+P&$G;W2T8;@fzs%P`uABgg7Nska%=M ztjlxqiDf=qG92e5{_iQOn1h;_p3Bfvylh@CS4us=c0i*Qk;eO1Y zmY)~SGCO6S6~eUzp9@aE50bKXUwTR_N6ev%o7Y~n%0IcN{Q1YSfKrMoc+GzRUx z$3+u8x>@)`(XNNW5j;#&ZbbQ!V^5@+G9sIr<>n}s3&0>sUu_Ac^}hxBQ<@49ncG9b z__+m!%3p{9c`-}{a@QL>`q!&Oy^yOfTz|N9xWRD4;6}n_!i|L+4>u8R3fy$KnQ(L9 z^59;9d!4HH2tjk#;&TJsX1J|zrEt68_QG)usRHgW+;O;5a8+>U;l6;o40jdod${Xx z)o`_Nf56>_y9dV@lqEPBPK9&A1;B;CHD+L*2z)ey<7!wdxCFQkaGl_~z@@-F2G^HS z>+k&=X*E~T>y+D8!LVq9pJe@~1HRJQC@w1I!89JMY@@`JD;{4NJeVAh)SP%Fjq-W0 zJYI<}N>K8txC7!#5&&D1fG<~D{G{>HbNEkr2PKSZz89o`Z5Wr?Xi!f$J~o;PdRi~%xpSkwhF{(53)-kqmaf& zlhXswb)O`}IjG9a`~rgUX-5F;Le5;tudw7E77D(qSwc|_tVp98GYck%s+#-m{|)&OJreF^I9^pVz$L@K1;^V` zPvEV9#(ej<1;c9sCd;gACI`8{ z4Ur1VyFh3L21teOdl0cZ zg2q@&E`CC({5Rnui`7>CE=)DCI8FVJa7ARTwCa1p05fY%wIea;w+w@7l3}u>vNrc4 zpyGXswVB&wDQ59no{wb|V+q<-vt^+VYpWNnEs!kjCDu;c@36eXSbJ?`L(3hBb)aFP zmQ|)l1lo4Qrzw?eH;0j9AH=QWmI~qhtDjj*4ztYgVI65oG*);e5@dR1xaF9T$mvNb zCZBLBNmR^Qxyy2cu}<37rj{Va9;L&Pmf@^3MMMFYBrPw>63bW@+S<(0k#(i-n^`8a zZrb4HfMLm08f{s~QnW5H9PjS5rUfX}gIJQqk50C*NUSHFZ((W29`lOor8R45dB?0v8cK zLp$8v;^QM^0w9K*aTq=B$AHkYq#i? zWihkoXhSbcI2%WYd!foKEu^>QpoNXsF88=7pD^;B$SL6~YF zkYds;X+kz4?c@v$4I)Q#KSe7}w}e^PMA|>Za)H*5u=rDM1gr+dPva}Ti^Hs)9BOHA zVv~stxAc&6keizh%v9S(h@_n1mJ&9FB1V9D{zX+I!2RVTEDko+>wB8l_jLZf5hfE9 z7D~%TT1K!J`55`iIRgcIE50-7@-voxuzCP8QcE3$ddQrOUdfGy6~d7TrkibWyyF6v zV{<5B9XhjQG;|QxH$hTi#$L?GnU)2nmjwFyh`A{xk1+Qu={8v=c~#IKQ7 zl4B`0v4xaA6$5P%_d>N}Q!Oh5wph!YX_;qYOX&Mq=;)*upG$wlJi86ALYJe z*<&gasL6l)11W8;CDBPpnX{VnRBYw65Z5zDjq z!6L9G*D@N`06p|J4~6Uc+B*XM{Y+3GIp$c*+Mqm3r9~)4X*SF|0e+OU0D^I?c6ov2 z0+cAki>N`NlqHsMy0q9blr^UgODyXIo+ML5Z}fG|63C8s!SCx>pq8BzYUc z9K1PIY_ww$ zFgKQbWJy9q^+%R7Jb52P{|>sh&vHU1gg@3OmT1bIWtN;8km3m5N0QY2mJ|Od%yGbS zDS$VfBh8!6btVIO_Oa!{KVi!)If%$BxA@6C3!kK#Qf3Ww!fT@-Y0Aqj>x~RO;8h*b z(Pzgj9jUy`5ksy$n2fxe)u!l2%z`;}rl|U~^n-e13JzKh{e7P=2x zw)`Km00anml_MY536g$FM>hSUB~smkrrl=>%DZTpr7io^;^NHnpiA0N&ATS4=oF+4 zIKnIU-v61~aoTc|J(Ronrp2KRt+Zg(_|NM{5wSfXuioY!D8(GT$%%_vM4)nFZSS0L6*hy1&rg9MSze4Ovj{FdC#IH`XZVx|1 zi-W{Mc9$E z#`{KM7&}Rq8;POKPI;PBZ(BQ!Fkg&tU6{*^GYC5nsT-~vT75j(SsG_r{}+W7@a z;`M#$@xP*~CSph75`w-|a2nOS!o_3kGF=ZB$H9V@?h=DwK^yN9Cy=A57zMRLRElPV zNTfuF8SJV7@C{vUDn^nr4Ad@vpGi~}A;vks_0;j5$N$~{{(+oL#WOIgAm*_ zLy=Un3M>5VSTT|Pscnem#onTOaqw?*V*1hD1K3Te9Ie7C&`MkcbD7#&9Adg7(CM~f z6Dm7kaukI?$yw1_^k;WzYin^JEs7VzsIo06nA`@n*F8Y50i|~Zdc|!-e-pFN?l$7n zl$9Vl=uk&BSSNLIyqL;-C_MpvVWxZWV7;2D_&SC%nP9|Qc>F*n8X<`i+5(DWLiu@O zFxJwbuS^vQVnr1`-6>)mqhmcl?w;MnG8)=dp zid1ns>#0rYFaF7}XdFL4oX2`m^#Ji_EEm5>6W3AlAT(ajvLanfV|}S&kQh|-q_~AW zPFtUZXzNEU27;uidRxhr4%1)8Kyd_Ch--&I$mb3~Z5IcMSy(Hk3<6UQ;8=KAy5wm{ z^fX@N=#X?Yfy;#ja4xudx$q=qJ_Rl>9*i+K(8!zCmQ#R74Du>W-;KC7SWL!(5|~9& z>QjJtN<;QDj18fLpGS=n}D#1fn4N)1Z@Um>9)|^N7*H2p|OAd=VNq zl7k0PO&Z#g{IrA(Wowgbms~ zf{%>Rq>dDihK%`N8aLX#0v_i5#z;+Y%Xn zSGbo)=bsm+nqIaP{#_AB856{zY#!~M0AW9$oZ0YRq4C*}Qm@kCY;mdSH4fLD%8Adq z6U9NM1r~aukr;?67}G(= zTCB){6kJUAaxm8}p@Nr0KhshRS4LV=Nex7IT4$4mx>h(XR6Ye0d_Hyh7es9VEuIP% zx%)3M9}7l&YgjAxe?yEcOqz^c&uQXpVHqb3IR}Em%SoOth6WUQNaeloBkD9ABwC@3 zozADsl?1%7OZ@^S_I1?dMG@P%m~I&WjkFZ_%k2F)CKkni-g(S5x{-Xc%j_ z2YhA%pSNl8zcCHGLsMpnb6GLf&H@G3YJF#mK8(G~MN(&B9Z<1DpemSX=ZHCMJw?1E zPR3$SC%}96J0h4W=Zh}7`4WcaM(QvZYTYKPnhQd1rYX57{(Y*=1xI~ADKDe`K0~2> z;z}d#{{y2*31*%aenAY-0AUm z89=)YAdL&hXpUG0+d~Pjh*#KNa=r@o{)k4tir(BuD_<2?(dySREexQF;UH+*Ymg`V zd2%Ezcuib^ZQzInAo$1J^GK+2s#pL@Rq!Z`U%p!fUd2{*3y6;La7c#{uY(Mq(3;mF zc@OgLp1=;>7x6g9(FK!u%^T204%3{47+^=J)gn-(Y$4{`qej#*9u*E{wf`b(rHS66S8|L>OVs%OT|dJ5?Q(Quu|<3KJJ!+ z##O`$(3%@dA>u!ymHA-lvpi}zJ4Yi6#Ersvp2^_J&ne2N zPDb&|(f%>Z(2+I#YfB;Kqpv7)8ESGZ6Jwm0Pz0C$J>Xn$W^xvZZ79AKG}QcMVo%{~ z02tDkHW7+3FNdUaQ^Il#{i~F>97O+ydy!Px+L#@n+7?07erwc{Tm<@kr@dapN9^~s znZPO79VT=&HiilL(pF$HxJIw95ZegXQJaGjR)8p#DX}6PofNIfdHi6tC!3xa^ChQ#*pZPcBj!(d-U?onwUBMRFRaveI}{P@YH!CFR4AbYs-jA-lz`RkR9zxYrD;2%;5(-B zfm;ei$w4VQFabJwVi3*VAzm{z6zQdfVsj|Ui$8=w^QRU&F~kBWeJ20|DYFzDg>zca z*mq)31<@ZnLBe2O7Yf)Vx`hxOZ!X&9M)>5tlt9kuqF+ELPeIUoIEB&X-N3yueX$#T z*Q6eTN_T_mIht6>!YO5sINa$%5}&FfJbqK!x(5R=k`C{IsEVQ%d&O{PGbDP8jOH|K zulO2vT(0gFkD6jc>iVA8NNxcrj#dn1qQ?VTBFNE_;kdbm*Ah$jJ`&qOhfdgsN?P$| z2T{g82%XkcaR8`Yb{aX##C6!_?oFs?Go)X}{=V?I``A=*QY~4(W!S zmeTzo)*}>gKpZG{tgn_zJ2!?6_W+jZiM;Sw)`_YQh??*yARJWt7mPvWA45cAE9C&t zD8~|{C_TVTcRz+wmqZce;*Z!@kt@Ve&aTM9@$csGVbkLXq!=uk79_?{?i@&dsLY&a z<4;?Z!sN+VaZVG>MV~;m=t09i5vO9i<(|L=E<;S^t9Uxn>=d4p&8JokCC-64Lc;xqVl7nS>SfCP%40=;>%KV(P1&n)K8?= z`-DcORFSrw32H=+cVV&^aTo>kr;5YCE8QPlS|a%RvJc&1E|nw-OiSy~g==^Ur+ z!Q?(ICYqiFlbI}y_|CQ76Qili8Pqd|CY}*TldB3M-hBqF@f@*A^uP>H1lA&z=;AES zJZ*3cL+7F5#t<7hYkY&*^G5sxBi?~bESn;#fcZqu6c{R1=!i*1)MQUo6U@r_FQd<{ zRf%qvL&rZ8`^i&0Y$s8A9Y1(+7Ww`~oz9BCL-VZ{WD=#G13ONmIp@SS0n?F%?@&Ai z7YxVurCy+lb7BwdtqA8q+8H_^wBF_CpB&-hkg8o_>v9$$0B3_05>#H?Mqj0vgX zJk$^aj5xtLX7fdQ;&XEoDj6Y25wARy`07L9*C_pp80uW`P&D-6E5Py%+ImHdbS^}y zw^Ug~SFd0IFZM($`bpR{w*uT1ph1Q$ey{pjHS)sQ0 zJ2BSBxePh^z+LX~i?riEg5McY|LgDvXjRw6IyU#t@w&ROPwVP(;hsHNS66kauI~HO zb#=d=sjE9%RacjGwyy4l3w3p_OLcXV;gT-b)!q5Ju1>yER~G~q3)c;93fv;Ncj5MM z-(6StH{ABCb#-rkQ&(5_ZCzcT@9OG~eqUGj(hqfYzrpSJvCg+H<9c0PtDjH^T=5O< znH%C83<~=7YVnF03VP=6XkdIV9BsPs8wTK8JfaO{gmP*18|LU$JmNJd<~m@_O{h%L zO)S6H7!etX*l(JB6LRS7`w)px*6$aqrTzg{rfgBdfa%;s(o+9~Dnut$DOk(7B}yjf z@LX1F`G1K?7OWCVyGTLg>MAL_YNS*X4RRu*OT+4OsE;(rhjJS7f<(ztSc7w`6#}#jxPEGV)pbRhmIJcqkFV(B%)iU9Mf4MuUQ- zFwNmB^)yjh81iO(%*-2eoD!o2O%Tj~o}bWZC=DeX5D4DwCtYL|7X|cd{H6IOw%s$; zAQR;WNh4T^5rJ(vkSbV8<*NZSuxNinvz8Mqxqa9UEj>)?Xu|dk5<<20O{5yeb{g4o zx1*^gE@`$8+odOyBdwvNrA0}}CbpXjnoA$b8d#1m1be`aDfwv`(NY`>+2i5Ey&nG~ zkH1gb5F-sS;qWLbizHX9ltJcByqRT!Qkc`;{N^mfJbi#lW2GLZkD*SS6q**T^pP}I zoODZo<(s2P?b}Lwu${PfAdbPH3A4O0SvO zN!T!?x$KlyI#k+d=j(@mNvkOBB{_}aM@xwm|E#1GeUJTY_XNqIt(Y&1mfD~rsdgc_HRCl&(z0KXF7f>d9-|>7%EFYSZ43 zW+R{hj69LiTFGK5*b@lS+)JdJHUm6byZaXBu^n388flfjbH__>Un~`Sz>iYSS!*9k z`^Fkyj}7uWw4`-X9}5~(@PQPom28&WXg3c`P(K4-@Ut^qcAceydlHNxQ8t`Bo@Di> z)GbmDTDO0T)UBQz8VIzaKESDk?aor^E>q8W6?C2#gbk=?tP;fsS(7O~*_O3?gOqEc znq{_ZN^YnmQ_V!AmTS^_pi;G8ilzKLQnLEFS1}i;b{`nJW{-5!q+aw&_(DU%6}|8F zOG`yGHS@4E59O4aY(d)H!_q|`)0ddu|F#ujF*os3X)cvnWr-4pV#p^c_}Vj6I!F20 z7{$dWC9~;kktX$&Pm}9$xtP*iwnbEYTJo2#piaJtVy5)P)^N(NkV>W=aPiI`Z5iCgL5rqTIp5k<6!tx{*qvI1<+loP`&EakZ&{)Dpu8! z0_0pZn$Wf6ZhiVJD$tO7rAuf_;q{w}MG*94h zm%GcI0f$jCfKINKUD|>ka;}QiTIo1>DHW3y7fODMKv(vaA*#~l`OI`vq_@-MB~&>; zj-mLMWfxVxh4pgzCEyh^Naj1DsL4-r50Y1Sss*$_ z;U+90fp?+lPmxYfv;IczHr5$h$#@z4hRwum`9)+_b7YLWY&nC+rA(IF!K*qa<5=rt zc{U0{`Vc>?K6SAM!!jG;LWiBbyZSsdms@NvC<4GWAXNun; zOGeT_Do?|NnZH9Gfkpr*NHc#ZV=CC8-P(9Fh>O6-yZoQM!Dz)7@@jqjaif`?n24Gt@eba_i(&Em4HrHZ_p6=Oydcd>8!c zAJ%c8LaA!~ikXe6;NT))8idn$4;7aqB{uJajL{@LCuij+pYaSi_6cQqrw+Rkf8@U$-{; zI=LMXO#aduNAV{?(6r|;O>fyDIhfkU3poBhW292e40#i|?}XtrU#8VzQxm-4+HxLS zNRG)+cwE`mGPRvoVtWmVvzXe!EAA14DP1SzRB}zXF8e?HXn;%NbLQHG);lJODYSm4 z08ltXTDIx9;@B zglg^*Yt;RKYlk(N=gIug+Jgu`Ozk~H4NYKUR${Ko!h#a zQzY*jYbYj)HQ!iAafPkwQ`p?X8uZu(?g-dPj~! z0*GpeCOa2R;kbkaVXc^gDZ2`@UCD3OEKZV;Kdk(y7#E$o9Mgfp1V?Sqeg0!T$tO5n zPoEtG(KX^PG^|Wp^OrT6OFzhxAiDIoj#fmS)y9FLTZU7r$ukWVUcl)Zq`Qq#jv4A#ae!?#Q=jxo9>|lw zGO2^S;s$F~;kH5(C1=_Cs84w%4B-hEOzKdtxM3Wbg+;$e*_7K-9;)R=+gv8~X)lQ3 zT0(Q%WFNZN9;3iz7tLB)b6c7Zm2~lh3E^yL0aC6vmKk0}WNKI2*nT&$XSMTfZ9XP- zv{%{~U6}0dU@MW-v0m}d8A2wbA*TCFU2Mk$(>RF^Smj4GcMscYlbYoPi)&FJb&<`s z4C`Du*_fuDH~J;#lstyYXIMvQ?mjkX!DY1daa%WdeD$}xpY7U1QIs>nhI9H{+fD6n zyUA$LGd7o&F~Aljz?kP;WQ(Sf$+i{$Ea!eE2?u&@n;4aZ*m|myyimmP=|XTr`4HO- zlbYj|Foh>vAa_680&*<@Nk=?xOZ#W(8c+%|ssHlIHB~PT77^QBtz?ufhpE%NQm6kn zdc2^4Pmlh;w06w@LJP+lt{pytll!ix@m2hsE!gy;M5hPanrIiFv*BF!n3=X1tt1Ph zL;bfG8ncWMkTbz{?!Q(mEf2-Go@l$sV0ZjKQMQJubG#~eNw0uVb1@g$n>5EX8`RH# zbg|ww+WZ%|pt<>`%|+1Cu*0llW7FY8R|0UHaLHEkmTj6zTVHIui$nQbE7KlKFSOv2?HFbB zwI*T{`GMZH&+8ky^L>48KmVSKD}B;2syqe-wHPxS)zn~;DV}UK@78RXm32iioU-=V zvO!L)6@%!;9vh^-2C3f}O9R5vpdD4N!t&5zQo^+21GYU6<^jSy5US;u+Y&7R{hyNo ztWW=SGPuSSzLlqKuc0C=biU%j2f{q;GaH0CAt97bnru;&cGyoUj2kHx`Pibg%Fk@8 zxs2E4`JxNDJg>cA>&#`mm)s}F{i8ayDEqGM9Byoa1eJ?zur0N>!cO)hxFcg{Ak?+5 zZS#@!!4kudZoGv~srlNL1oT>6vBmNR^OY_x9oiIpW1WKqirdDQs7S{u(`~DiS%p^m zlkEaypKyOTqqGckYuQ2BMH$Ih)8>!ocM^WFeJ8@C2Hl|te0eE9!&)u6+bPJDL2jP=UzO1 z;r;}e1EOOmw9=xqXBQ1^&Lt`r*%w}#U8SVlGAuXog;Emb2HN89uj9z2D7o5QtFl11 zq19rEu_aL9Gd>iu?c8t!6M~;s(pU-OVnGkM!+4CCUXDD@j&5}1RVm+wBROaqDl+sEZ1eB97l9iY(a&WfUq>7vZw zjCHxI0*#7p8(u&+g*xdNL>-4uWQBzPcQJ>>_BWN!tl!%vu0Seb$9x+z?bJ>E^> z#*UO^g`0Qg7~WoZy4Ix9{$wS#=+SV6;!_mPyIoTB>Z($J%#0KzsWCtA-W(m@8;)-c zM!-EdRu8y-$hEe+5@b{sOBvl!@%^a0?h0R;djR(SBUI}h(pvOTV)d?i2YXCeeZdMi zuCwNGWimXqpR&|La4PAi45cjtl=zK_sn}E~Pg4>pr@u0rhNj~y>Io%-&ZR4HRPuz9 zO=(Xm?I~@5GQ#-!^G3Qd zM*S6GZaJ;t%uAV<17O~HQt@YUEh3VUz$oD>+)gSPsHFPHzj>g4r?o>AsNBUSvwYJN z_lH;9e>`!2dd1!H#NFm`17WkkIue$Zs3z#2Pr`7t(e9MUHB>2f-T|cdZr5F^8mjmO z+y6MRn$Q@YmExOkWnQ~wQmD}}B^ zNIb8|nwVfSKXw1K;tP|7On;B|ZMwX~2e$ZkVFJt_Gfgl# z$6?sl49B&yj3k_KUDQ}{Adfmu(M+mL2ip5K(%j<|7Z)Dvc}M~bsOOCVWrX${Ayf$q zOfL+>n(>N5ug*#p&toXLZ{s3rO{v*j1S^@IfRok+f_o?E1>T;Z%*9T~%xtB%%FoNy zU&L6aoyt~LnVohtoA;Ej$9HHmrzo!pEu5ZkL-_oNFTc*h;ru-D{vJO-Yw@C@^+pv} z4`8q!*KQwBaA7cz_8(Rz(2Vmy+La8$K=KjA<->xt%;QRDO901&ABE+kzP{uTDm|n0 zHZ_u|>r~`-R4VJSg}3%Ir5oL>RF?hMJTQ!$K?k0!Qi4rk4>CGP`Ak`6EYsUx zD}mbVvkEjt7;4We(Kw=wZiTR`Q*hXrU!E`dT*0xH^U5auYE(UP{N~O&8vnVn5l2y+ z7nJZ2Z`3(KTp)yTzX#<)T3&#>TSpTwC~e@axd57AAM#{~pLXnm@|_Qh(6)Z1{BFka z@3n5EMczlltW~;|Y<|hC%QwnFcNX||J`2F2cpH6~bsO(q@i1-&+)_e|^6-?DtJ-Q74C1c6t(U=bA+!9K z68kW4++X?xk@**&X|y?j!1ZcMxC>!fc?WZ3ORw)({yh#Se5(9ay@T!ogJpk%uIp&Z z-{?liJtc~+84+vmfl)HV8MjLXHIbRR$kckQUsGtgxS*6O;#SCZK>~d` ziE2A|6Gin3a`uWxm-Kf^8QvLlZRmEgyQ^%O}u^x|f&R!fY8TlZU zOD%0E%@>y`^3?!I%eAW|45ynC9BM~+d4YJ6tXRYeqTH@cB}#i8uZZM3)LW1xuRGO+ z@B$jDZQwoDQ0*oJqC}W+lbq<{mIY2a5Q>Q zrl0DkqZ>>Ga|5Aq`Kb=h3w~-WY*0>vo6wgK``fXkO%71~Ves*eFCHIZJmb`>o^>+) z)mY~W82tHpNnTBFUM-dO3*>B8>aT{gK3=dm(;0xX=6(NB>Vw)I|3`dofI36Jj)-D) zYL14_SuuswK=coEzCg8`LA}v(KU8e+X=acbRP;1XHAq2fyoWA%zcs{h;UHC#Q@!D) z>dB1OPQtN4cMCj2P#%Y!Cn;D}{vlU*%ldm~1oiM14fP3DUG++VyBQRbEyE*lG&EQp z0kp0MtJ~3KD?`-K#=Oh;&IMN)IWKc{kuwO#IFPDB)S!@h5Psm6ciMww)<_LSL5<_D1g053K|TMh4&;Z-*Rz1C5yP<0-Tr@Kzqp_NS!)y4SfFo-ynt)TEqFqhE zPebTx6BIj?8i%XnaAfTj?%{=i2z3I z&d)MXNo}r%k-3HHBKHcXLd%+~N&HM(b09mxfEW~w-p=O54S^XEy9fdF&`0T|?p6FNy}HIZpy2wIw7K zUI%CnbW8a63v|7u`YTSbeG!Z1%^)=nGGr$AaO{7hGlufx(7=ClLSa)eP91}n5fdIk zVqz;b8TO=^t<(?6k)UFOytUdMC)uuc1hOYvtMNF_R{!lPia{Z{JR?*!-t+}+(DXds zT|q^UsL1nehpm3 z*%yzrbb{zhYYQ4K;Dvao_WJ#A2c@=Cd*Vb}K|6IjDIL`)T=qltGf=p^=%2-uw^tY7 z)(23Er0fo8&k|bGLG6bZ0z6p9<3t-;G!-Y>>Zzm9u}4t;o4mqEitmVAg_PM5%)5+x zu;g@vm|V^YGYU@wrX-@d#H)xUWwkT7s0HNN3LYIzN+&cGN6A1T%IKtyp+Q}M=%Q9& zyqZqxB7TO8_p%E zQMmqr2+XowfcaV)+(nIK?;270T`(lqQEeA>plLm3w;caKZA4eZ;TFjLZW#CPVc`ow zv5_*9)o5J%xSWiVwI$QITcbh+^uxO^`)>xH585l!!}2Bi@+1P`Xx9M9jL%3-!{+Q+s!9j9VMyY{VH%{^ zIqIK|{yNX&U&NhbgRP!av&jD`Amvxg$;d#V_UJU>v2VW7c})PERgaLou^r^~~T_7gq!w7QUzMnZO|&RI;txg$~N@3eQMI*$%zpxTT?5WeIpAmb(=m@^!r?GK}@V=eMW6U?q}6_6Al?P9IZZOGFj>C2sMyUcfQF7kz>?JIDr}Q0+&H!Ayoz1KUR${ z>JSR^_*gX<=NKNOi9BrpObP097&bDkd=68$l~!gM-4ln)l4yA91dt2o3C5u_6{;Rr z-#se-9>OnZjDy&ooduF@nE;Y(%0gE;a63?4#qThWN6`(b+4EpxKU(uVa`;o`BsA4A z0Zk3yQEh1c1Wxrys4eZB6OYzS1SK;j@lKe4=KE&@@!xQO1P0hjTE_1s2F&&!;q!V9I^Rc$mbGcu@ zVBhm^40cBnXT=vG6>=SxN&wg27^y3QM%lLqoYs8d7T>j70pupO^<-BUJ3}LxLKHO zI`XnU#`4NJTa6Yv0oq=evI^^rWK}A3cLHX!RkP_)(5u$jlJaMRU2p(l4hB<35x>#E zBa)1Wn%NKlUGO9iG?%VCsvAEQFb4`uGVUsZn&opa@KfmW984$Oc@%$5OHXm!box`) zOKKbzD^o_|a#7A69ADn@62|&t)MYMYLC;(;jB74_#^9@HE@tLFq~@aVz6QX}`vCrV z9)MH>puY|PrC0|aV1&|)P`Z)%+RM;plJijAK+1a=)wz6OgDhTcHuFo*Bkgz__fKa} z=)vmCXxvk{7>ULW;h??wC1S>CYhgotsrOZQbRJ)_g1C?4nVT=OCAN72^#s5*nL&c~?E#3f2K z+VrfICPnx*p&74$a-%s`=(saxNjvn4y2Xc$(Wbnv2ANG`Azbd7n$niV>K@FnjhCT; z$^P^bhoB_;X1qP=ifbR(g9Io_tC|0D8#a z0(Gjs=2R#>ttsy9JmSE+tNiCifqDqnMM~eqQXMPBLh!F%?LNv{4UR9)$4I)nOuh6V z5p{;+K2c-f^c~)In_UDV`{f!5M^|BNJT3_zRA3y`hyZUiM~>m zOwJqt^Hnx?#_BU+4cBK|^X;%#omN`1O8t_Qb!buA+YnJP>!81GTCL8Yi|hF6TLU-_ zW#P{DQl1SUQ1y*UR;!XW`)v>);Dv`PK_fAUPvZe7*GhjoeSNmkyX1Zy50uY%9uhij zty=7S@!>ogdzaTV!>Gx%4mHhuP!pxDQx^sN`{7J_MOTNJaOC7Af7~W`62^&)_wCrv zS+DjHW&s?h$NqE$$&1l`ZcCd@Yy%onz8-CrHlo#+_*WGFs@c?3;`e1XfMsw~hJ(d# zK;jIZsK3jFdonzh-;>d1Y*42$tSfj-(MBMPZDyVr#=l=NzE>Z`<(gM1Wg|*_&4|k3 z$qS5c{k~1wOx)lo-lzsUUw^o9+VPF5pO5p6hvTXGeRT+3+Jc_S`T$(Ki1I#w>|e~i zNOJS2CB}Ey7JM(|-&h=PK{J$X5I(tEuYG`PG35^T*w(HtYS6m|-J){`4+xt$^!?mpgHN-6N>i0?2E-=Rha zyp3X#0mc8-4<(%G-l4bf_71h5XMdpdWD`H#s0yq;MB+QR>xoi|sq{m&w`nbAphtZg z5%wP?3frk>{m)!$cOuuj+NquDw|wWKRKr3V<9-iR6>R1|7Z^+KV?KC-%Fhl>{XCu_ zUcFb%MN;FBUCP%xxL4<(LHJ|2jz&%IC!7FA#w zj}vSaI_#cVyH4%g8SqRcy7jXZ;qko+gmPdf=!2PL1> zi81jMmI-CF_Y|}x)Oy;e^|T)O#c6edUWPykM=@+ioKg94iQ{L0cNul5#F`DLRq8@N zrAnRWfvvUM{faK}dG;#TxT~Oilu`fBumnaYeWqi6`!mdKWz_eq9$IU7x6fkrS4Pv% zVOA>BI-J+3M46xKprxPd`GpI5TQ^+L@njd(6UcGuq8>T%3k(&VW$DxzbYsaEP)$LX zFLeYl0Pr%=mk>zUlKx74(F5s0c9SQV{uu^E{#WQM_a!Xp%c#X=^#ge4FB`4=THS}x zy{~l|zj8(QRJYE5_uNM0RgOMA_Ki9h-r;X_v_rnto3{L09i;JhdQTnxP7n3}UT@3h z?{!+RAN1}o_(6}X{z1<-{zpA@_(y1qpxQOP+turO+D`HLD;589b)c)wr)1JGY|tP6fs2kJSv z0ks#UpTTn3RRevjjE2?d^tftx<7+((j5nA#^IfXdYi#_RUd+|s^ya4gt`5}e!cO1mll1vhl!rT_5&uo_z4u|ISI zUH#)eU=@$fzlb9ZCDoV|Fogf3_V83$Ro~|N@Gsa@$oW$}$Mj}HMmBhis%jxLrrp*@ z#>(6J&~yH!52ww4d76#$=U&Yoc}E|SoA0Ps^l}@KGovw{VCrj+p~}0ubW6Xd%fIS- z`e0c6x6Vh6>-2o%>-5g8s8j!BWy|;4x%6-{I~O!-nVk!od(6&xE6-#HgKJ%U?42QK zw3%jm5AN?5?DKq(oFdx~>h+sx$|;N#*EMX7=e&>gL3|Z7ApltQLaVIy2?%wu*^Lot zrpu>|f#oR7Nkf)ORVq^KiS=cDp>|uIV~?U@n?1@ChantW59?2rSD|F=snm&`pz5gZ zQtbF!M=_O&_bU>}wZz5OTj#6modaR*xPGKosei!VY z+|Um8*M>E;|A|c_Ej`r!tw~;wZW@H1s-}q1*g3@|>oHyB4W7s?lzGlIgsZgMf;&^% zNV^O6I4lifVUOc01j;`jE@|Z>?PUz6xjCck0|8q#%H9#iIXMIPy|1fp`g>s?7}}fu zlvbq@YSwZy?ATMqhX(ehX+C*$7*}gv-UVx>heb0Lt&|7W9%I%XSCe`a~+SO z#Icy39Am%^JeCHHg?^{M9Q&ac>`nuAlLs~l3*7!=?4#gq9Ru{6(-&jx(R2uTW&Tz= z*9CD9k1MtDcZ_97#BfiKdl^`$zWpC+Zy9(>k(rA zLR)bVjW_uihm56~ZZKhG|I4lj$I$|e=fQYu)ZG!wh>Y%dSgiP8_G}m&)v5Ma(+MoG z{C!%I`%AM_v>B^}X;aY>(@87Yvsfc7e!9KJ1UqEJ3?P4+GG_qmGdzTa%MAN!7$bGU z>KZqmmKkHmWz3oO91{$YIzo6`X12YZa1Ll-Bd^4&Z{)p%#$?R4APd? z&>;S&iA->O!FB$jEIrJhBZe}5wg+pDx%Ojbc7eW_2PtupB3`k#p+ocSBiI)jzI`q1 zf|jt*e$)pb@WZv>rS=*heip6J9t8WP?p-px%ZB&0;a#CT4zi0@7TRYCe4sVJ)0|DP zooB{1rTAs`C^K#?4qjpJ;SZZ8Z@NBuzA;#;a*KUW6bzgC*!a%qipnax6mS6rNhqs+ z7moLI+rrFi;gqq*2PW$CkvLO!0BYTSd!W|+Gy7?QeXlt$+Cxq32d&kY_I5J+QOo?+ z-oppx(9Al!{ys6TjQ#-Tz;lc|1~;Jy^`2O*GAV;^ez(@NX?p;YUCjK^JLPsIJd z{x#^mKDFq*+k`g4pwLS|+iLCWeb`^x*gxz8O)!D({nI{IxP!tQQo&tpOV=F7Qm5pd zAhVWn%RZm!Nq&0L?!W9S7;+>u$Cmb%JNDIjS|BDEydaWRhi58s?t;bf7gO$Gu-@g3 z)c*jA=^ixxp=LZVjlaGE3#$6Jy&IiO;X*nA#(_Gze9zv-gga;UzwIyRWlFTxYL3JM zMljJaV(<9EME18m2G8A8%)jO>~2TNMqHw5>!6iw$;-wYUEJJ@}rVSF8F_uUTTtLp39&*X2T)*T}P@%IOO zGvokp8#h~QrZ0Sb&tms@s{{3~qf-vwHh3b3hxGFdEdk?#+Jm(Or!S6ZhER1w z-wUQjD3g%;lArG)|4@|4`7g}lH-=9oe@D3rE03Yc{=Q>Sfe_$3oZDRkeEmZBP~)df z_)r6^ju4Nt6U)J_eQ|(qE^MN6*#`3Ds`lA!3ge2ZZkc1D0wv3Tzb_?LVV?6Ek;;hiD0Fh078Su2b1jTb^% zdC1+`o$p=PhV^g#(T0od zeal$~ZDj}Fb|$?2qjND{&ZHIne1mr<`ns85K^+Y!^Evz-h058OrCj6DX5~@eV$S{B z9`)VE&*bO@;-v~ym*hLfgyT82+kE}BTU~uiMB!1C;Cb(#|FtDkXB+)}LTC zSfR`PWG%k8uh}FdAi{^L`k;W+zP_m@7?FATT1h|O)fU*nS=Il;+`GqBRiy#{bGRrZ zc=kSfp92ag2&Secq^0H!5^t#qWvM9zscESN<&=$@kXo9W5X#a*g|yVtf^6DWS}@wA zrG}MLO;*@dOAD$gO|AF)taFZ%)4cER&mSL;d+)W^UYBP*>$$CGJu42EuWQ|NS}+cc zIqrF!)KGAf8y9l|3Q5M?Tz7dW24>wV3H{(CPI9LiT5Mp*7`5Ofd5xPR)%h~P? z*rFR}yC;SZqYK1=eMqRw9QW>ot9kB0nc|)%S8)?*$4^jdxZv%SP9w-7GNojZ={J&R zA@gzkWah|EvR|W)%ylQ@(*gS93sLQkE!zb_>wCYu7!MCU1&-hE-k^>af!iDAxs8zP zTBv8=O1W4ao<|l=e+Xh(Y3^nC`JauqRaK!oGvsdj%G5-NCE}-FDdmP&iMy9*5{m&(4;AmATlBwc-s{Sqjg<5ejJ%jv*@_WEiHauB#dQ#0b_M8z#aS8Xj~fx@4==BKME2 z?zo`3I|J3_tI8#OmA)9PD>&cJ(){komtCo`xIH113m4OmyHv?y_i!9XK3?pO!G>H^ z42>XE77^PXc8|r7tV=T5Vgaps*xd!kk&hpC$A#ZZO>W_zn3|Rl6YGVgoVoSFTPdvc zEpd;Q(=?a3XX7)XF*kjwJ6#Q32EMEyTdVsoX!X26s|!`$GFn}~)SYP-U6AJiRk9Q^ zKmUT{1%Xc&%BSwmX^4CgkZ?6Ep<=9kgI_?Vg=)0sCAfokE`m;E9s4 zj?QopB?5=DZyhWY9dubGl2-%^cFy1S_n8{D}G`z`?Rex8FY z;($PzS8E-3dRhbIt=bG!Ifhd4w(xx)d;4lc z+c^w1O?=uNj}FMxk0~o5EPAdyeEJW&K5S9qf@jwjaH3xBAt@!y`Keo&zDH!1pd?Lb77;DnRGcpbwLf!ex41uYp&25q z#NqOyFJJmEL@AZTuLFYt$ybFpup?yF?^q6=V*rmfA;lHXxqEnyT>!anTBuJ}x!a_D z8%Ph%xZ{E6;EX#Fcn;3E@BAz!zbjllw~BH5UfotjQyPTYv{g~*7OZAJ2c$Ln+g4ZQ zjt%(%2G};P4eFjAtDP^q=exX4#w((``P9fA?sXEwpN>QZttzn&k8d|a*E+JxZ4tr0dLWI+ z+70KncO(3;k0g-L12-4$fx&L(NrKwB+Z|`N0g|FJNpT{rwN=M z=%cd#=}ru9CxfBVn#II8S^sn&cZDaD5Tz=|hsT7c=yyq@u}TfyjFqc!4-!Uu-Ag|} z8um~pdQ`R%+WqcsT3G;s#jU!ljtAV^5txr0aNo)miB@BPM#`1fZJp$*N4=WsggcK`p;CieF)xU zI<+7AKb-NA`=Ll_xG1pg@cWLjcxxVZza{36Bipdc=U+~fD(WxIT67a_Qn^g>{h1$WMVS_8^MT@p|`3=|aKVmZi##FwO=e zZmBB#!X4$re&HUg-+kroDH`+BU%9UgbU*KF=0a5k*d%lU5jXh4D8PiZ={xr-5;DGLJOdx>_#PG3 zfA8>ddI)-3(vK*CIt^TNTK(kyKGgq}r7bVGTAg%%q)|;~Nf3!bm01s}SNuCULUlRi z?iB#gk&$@f6rOU=)X(h5`yH!V;%v-A#;@)@O*5rm(l$}qr(tbf*^i8bc&RG7)a*dS zz~=0FI}PhOt%@E>N>Epxar*w2#t8>EYUT)(-8gscx&H~pN_y6kuO z;%Tgp?$SVGw_X?CP1SMQ_R3VF7wE9^H=~V8J=)AJZP?6qhTq*ilyRlkUU}Rgkh8qK zq@4_*EbR-g6nKdhK&I&VXNBRNi2p8Qfop^FrOTKW8hJVNL)gL<&bV-+MOdqzJc~+e z$pq)`9KNXR-C$U8q*2TS9xxu8*MFd8#l{fxp|kSh8a5XKErsIrnoEvb-#ZKVuxvr2qZZB zOrwV&HE&D*uMHLY_P-likPsE4zOaleKfwIdiUZ$lV?2c?d5u2*b;v**b`0#Xfo z0ga5$01{*@g3swZOP=6!1`pDj;PX{HH#LF{|1H6D;!LM z-|@Q92Va}zGosRl2GW9qEFTUFq&02a)qymuqj7w@N4^~qNNd`tk%6?P4Z9|g#)-;& z>%_(wL@0tMwPM)*KV33fGv$g~0rd;B^Jd^56ElS73xWl~k`<_33_iiM>_D1K@?hGv zfwU{wtwRrc#nHpjfi%I?V7}`EX>wd^Fztpw+Lh`^Jl`&oZ^s7G`ZmcoE|Au*N!pEp zG<-A@`1XT1<9NRbfwVzQ^5q25g0o9T>ZU-N>~#vZ1?vsvbjl698rI}hULfu2CTX`g z{Su6cp{|KeWuh@#kIMn%+rI6LOaNQd&WMASuW4tn40zf(l448?5l(hZ2jgck?tFkm zuPyPp9gP%Mq@cOR2IcC=kd^l{B3zT5>P}Mdtxng@#zt5B3&&>)jS_u83~_>mnkuNg zZond{tI@HQP>=}Hg@grNn>1BXW(VrXGLj;gj0Ihdwn_g*SolQdvdjW0HceHN4g2iD zuAmLw^L8`3hf9Mnt=?fFAV|H_xa{v{#Ar?xoCE$=CG7LWsHjxKAWLb};V<9pY zFG3JWeJ(MKSFX#90bDXJGfF#2V}*`S=SK);eN6IHAlRR0fsXw7yP9@gYuU5v?QZnM zj5e~n!KTRG2Ahkz8x`2iI`x27t;fHheLr<+c~~>GsfQ7(-P&x55agQfm$e%%OrIgL zHHusjUL5I{8)1L==ng0Qaw8_hdnav@5tFvcEX(H^XNmqqFDUM5)VMIXW%o9w&;r)n zIls5J(Gerte|qairCo_Hx(sHpDR--kK2%wArO`$2Qr^Br1 zZ{GH{;D7Je5QLfL&m_tLL2qN3$l22z?`sK#Bz(63jkuQKMhY}(PHD0Tl! zt$Zqdpkd3-un$D-P7V#jjdSim+P*-vlTm!>%7n-+bkZ`7A6=1BwkRh_s%ty_%xT6^9vFQAvQL;Mw^&~rmtnp1>*8rxLrGy_BFJme!Q^=3U=EB zW4$N<(Ki{dgo|VpsVbkA9jP}NDS?%vBRRI8uluF$$i?K6hPG2h3o*PWu4onEOt{%d zq!?#zu0a%!o~kGh#91n^>!vFHgT7eIlDMjgAU^b&Jfqyz(^-9s!O{rlV^1>HQNKAE z35KW1MzU^(n}|Ya;B{GiQ8n3!@JidHr$QEkU7Du$lb^}kIN9hKK8+kMm2^AC<@8&@ zVqIu=wc}P}J0<^hiq5%uiZNXG3w`iQgxE7vjJ`s^ubgV!j_Fn-PC8L#RmB*Lfpt^C z$R?zu0j4OzBIVTWMhAbUU1bvPn9!0n4zcIG2N(hJ>o2zVJs1#w7L_~t*1J1rx7QOyC~ndk;lpT0JW!DlMlpj z4JlxXBKj2=ZO!F$JxFEs>{7J_Fsjq);{qdwOxbra;tls0Sh(&o()|f-UBynpT}%Up zZSqW`gP`%Udzd8WvyTYoEOBz~MWSmZAeIS}%ugg59yM-p#=!B)6W(V=To9ii%BYV4!Ha|Hxe9(qOCV z=8CN8B;9X(?P4S%3jw=ewohe0f|a*w3iEWrRKr%&3yleS=>DQyBX9vod^3_Q8(*QJ zHWV6DTWbFqxZGl2Ot{~v`M%{K2s+Dh<4zU!C?#-ow2>w=N&W=wZr~>ZrThg&VtFs} zyu23@Ri^TajqaVACd2sBCwo0=+(}PsA2s64wSm&s1+MrrZ%2kn zkB7)dl^VU&ij_v9+OA-f`K3l?$P*CS2iVi0Q|cvUebbbz6{Ktkrj&7_=JcBd>n_3C zTDQU&8~!BqM5(k=!-{+=P~}E7vdkDBvMKP@3oDIT;hWEAdpeNq8Gp7d=L?@1zEx*) zK~1%>_&I-;s$dpn^uluAs6c9V?5{G$vj@XSQ8lX!vC%_>`(UHjmlypP$A8)Gzr5tX zysR=FGp-AHB}!eo+TBhT)$pL~9~I&3d(8MEOwD=&0M)I774B5k>x|^mVrX4Y$5mmx z^cP-sqUGLV&g71m&EYM8YaVRMEqD z)7HOcbo_5#qyGAuG4TKO+5eBl8ZPAh(l3nGd^PL~V@%|^ zuTQ&a;NKOqrsav&`R z&WbM$!#r1T;N4rQ_DiEfz>P5b;dX53sl&s^_zGJL#1^)KCUX?7o~DY98q2wu$Bf~A zG90639s`BRbqq~LU#6&vwm7Whjx?imqqT_@e7`IvU8PUP!7x9KO+s}R#_ilEVq@8} zj1_b^QaqN}|D8>3ILYKnJPyCqwG3BvyP-sNC)k6z+KIT+CH{vFpa9$*k8t=OKGX~o+}zPDMWz0Xl>iUOpCOf?!plD!7msW@rV=ox zGe41$q@@=#vp3I3;z`D$!ZdAN zMVP8|o5}d1W5F(-NaaUOGm6swW11pIuk@JHcyd`LX8J#?Y2P^5?nxdd)&Ww$lq#xekjlk>?-6U8n3y&H?PRw#Uvd3$ayhM%%+JLRakicLnqc{>$!2ShV7U|` zm@F7f`Zvku{c3Dy+FzJr7OS5Ecl2a#2>QZLL<;TO-dw7tb};Fqj`@~Nxjen;^lyxxkU7tG8&Tb(Z1DaafcXTp)1Ps{PBwt(=mZ-X10s!k(_9f=M ztm~rwVr{>~oJt4-tqKzbHB2q)Y))6((`hrlUy#DR(6Ic++3c0l1<-0c7VM(~0w%nll*EOl^U4C`Q5n2WUd;VI4Q7E|^jO`FiuoS>7Man7O*Lnxzp zHP450?p?bu)|!v>G-IHAr+S)Vg_`lsH_`3p320&(iE-)!5sd z$M_ap$>dK{2d^~6f&9xWp&OcptL&-d9oxsWnISX!m_xYyy^py|Qx#Lz?x1=18DSyE z5cMiT*?-^HOb4zf`kFmM&J#xZI6!8FsvQ9MwXYwGAp>yDPE9Ajp8Wo3SAS6juVdXx ztY=*W#Rsu59pHT97cY$Ecq~?|u)|!l?^hp)P^A@9@B&I&6+yM?83r)_8d+^#82P_K>6We{=tf(>R1t0whVp%(nqt<1n*rIFIHi^G6N8mZdrSaeHRX zM`dlpAds46#tK=<0+8felWo2mAh{XD9aR-yQT@_uHF2uG*1TJnk)(=VPr~16q-i)K zt}_wupmP&wl-@JmFxted;ZI0y7r}1s>&;mG9YOi}#}MA*cgox`LF!em8-yM>88?`t zg!z<=)g&}+97ISr23L>0c$cT%Xy)qo6U>4Bub}%A%pG_s$cVA4m9Ff`0ldgcHv#(8 zn>4Qf*ZuJn@g%v))I!xwa3T2OO=b(}0oOQZ&&?)#F$wgMjqr6Q&z$2G+9v{|Xv0Ar z^0c$;7IT}+^{bOH2}Yvl0bF4uro=gu%`+E;iz?kk)tZ#JD&MScfqHP?9CH*@+1XoY zc4)!bDUD0aDb2M>kqR_bWm`$9=@1+wVFf_>?LwQ?@1hH#U#~E`gy1aq$qMs^5S$af z3r)B}8?{10qSdAG(N~3pMyubh3U4F+>|xDB2n~x?&#rK{7N4~!HRk}qZI8EM6+f{I zpoT}QR}%;!LNu=^wV}*pmw-;WLUmDQugK;s_lPiMs>a6|;6epmjzFI?IlomUtTOxH zOEGShIR#&eTDd@{AII`YcqqWU8g!191Ojla22EQ2@nuJqn?yhew>o%;5vzF&83SjE za&q^5+}waO1z+BYGX+WWv4<7?om|JuA-lHIZ;fENSIt<?K-n4p0-;Gi%z*{oS}m ze7wQzsk&^Sv<~X}4dz4mB#?ABcFgQ2;lh_V(N94uS>8|DNSDB!EuuDTM7B!pLd3L% zjDZYg*K;q@SyVo<5y*5?2R8w;MVshNs@zLRkjl;Gn6fllc$wVZ%!0A&XAfVJgW5(mX?N8VOyS!3mKTDTZ zYynt(q*YT`8l{pUDt{}j4y%SDj@S&;8@BPE@dRb(U&g+<4=x2Y>ZwY+x1S}u2IK&_ ze;hyU6VIBv@X)S)4ms^AHLQvb4)piAz6y9|p6kD%w(Ozc)N1B32fkLrO9o5*IKf^a zK8@ApXdJN3=V=!~2n9lf_k!F%PkV>?GZyxYj(1(%1a9;_JTQ!pdossieCVKMoBZ0Rl^IWcwB?89}!beqwUNW&2rbZ%5*@`>y)`2 zjH`3Rlh-kO;dvcQNGE^@_cyDlF9W>=+kxZKm-#PI?k3dH-5uNM)>vh}1nC;5(q4jT z-Ke&{M6GjPGE)g8!u^==3CvoyrM?Ub#lOtRuGm3wbEKs0JNU0bN++IJDt^^RUIsw9 zYS=4gx9~juS?w!)R{RQJx<&1L1$>^Uy6zy;B$-&85WEBZQr1rQx5tc2)f}HU zitqSO{u{9yQZh?Dxf>wer~2)ts>71>H+A{zpvi21{^Hlc^f{{Xb&8m)BL7L|`{fDY z;-3I{o?7`&b3MT-G=0c=1G%C|mApac9#BW#pvUvo^?S_aDsexUeP)ljoxl{N6G~w( z!~dYahoo~d=$qiiLmcW$Hy5d4Z&B)EA!;#d>|4w%W1qPcw`L$RT*YTg2#I}?x}Vl9 zk<{^6@#pTRk;~MVEENO|FhU!V5ZPB5*G#In;ZAp#WV_8g+^xo?U9 z#2Quj7BJsXC4WQW>GC1-Vynve5C}c1j(uo8!?xL#|3)dUA`}1My-D?^RrV26w_5f7 z$m|^X{C~gMre6Apv3Nnb4pY$I)w08|%oo+pPiQ;A&qi}ng$DJAj~Slr>d42W>$qnx z$^A6^k4JuD-l_IT+_HV2m|Ji+zVB0J2A;%!&9RfB6Mt{gxjYM}LWwuunK26YooN6Z=uqj&fiA z6}WQ1sr?F~BBq$5P{TUKV_P-!D5X~&rBw(02}h5jyuG8ckCFFXReOwi_ntDpF&_#) z1hDbXjEX~F`i8>)<*zjVTlDw$)&6gR`Un2HyBr6$AF8>>k=6dK(oUG$!aw3;k1F^l zmclb9%;~rf-}asPQOL*0Q8$>aRqpq2lS!)Rd(fCe4jLG&xF#3v+p95Jo@WP*EcQDJT zKo;T>NGTzw1J7py&u0VAzXhIuk5&iTw7FEJUKz)1Y|EP8nV+E*lpoFUGA$CmJNe~9(P+MvH{hOr<`gi;6@J-LRS!i)XK%s?1pS25CjPH(HRCsAm`n#p*Il8=FG)YdpnrvU z#&X{&)FWP_+J~be)D!UG_y}dB+OcBz=*ciovRGsGhI_=Xw5h{}(ah6}q+!iG1LX~V zs;Z)yC+eKvY*4GnR6Cn_rfHXwBwRgO5rw(AM|P}bS6UdcTH}#uY-epK>u1)k&KJZ= zoj==4%{@IyZ*1;)SDR?XqIs@tZiwKvS5~X1;*QV|;n8J`U~Z;fjpw!z=@CzoevzK} z=NcBYzEfAE=k9Z5%3`M2mc$G^K$%DIX3f9I)8pJ{V7C9ge1^N%|K(j`3r~;m)2LwV z(92<|V0sHroqldZIFm3->@znG@?Nbfq5wG_I8lHwO>On!J!3?BcF6k!(VnYm_*pmJ zHK{EFtOAmUYPP>~+fuZ5D+3<{)51N^tOGr&KJ>skr^lDzf{l|CPZPl4_96Bd> zJhtS$%j3C64@iHNw49hXmZt~#F1I`#xa3%#Zj$K{%X6h%-?Th;1Tt4%kI^;DrgMHE zExQjN^~29#c*#^-ZNAohK{K{JvNTXT17w_jE1G^6ucweDTY7l6^dKq5Ba7#ag_xY` zVmv!|wJg>%N?v{3$|Ii3M>07-CI6u|P^;FSd=jc#>)sw~?YUQ*2Uxe2ji0$<>}$9I zJH^sCjnS14d*jODJyr5ayhmIQPsD4~jZV;bnw_A_U!CBIL)j}x_V~Rv!39Y%)rka8 zcRosLBNylTHXdx!Y_3f7h%@8fM2`e3|4$;5B2!gf3K~?2jU+XR{%T)s{L|w-@lIiq zhqGdI6A00m?8!xoq%K+P*qQ7R&!w};o>!>gr4$byFqSee)~&n#Vm$;j5}%-pJskLy zsXpwWUnO+ZpX0-gi`7KzMyY!+DHV70ObsCjTbs9I+Lh*(vA)~Mvw@GK1VstBE(l7i zBb_{NQQg){JleR5SGf#z(te!F{TZ0QGRq>ndgAopMyRyV_DG^#b{ z(r>X>$nZIPx_OoggpxMH(WYMJN#uUEjFY~>0#Z+>!s=b`mm&7YQTLg;_Tcs1P8(& z?dPeG0v4x(0}#D*&+z6l;f8qD%Lr^e6&I(fhIu4js9;PPC)Yd1)t)UbO+1+A+Au9w zO+eJa;htysF7FEfmFbj>@GKF+3up)WN@B|`jjQ0!;lit62 zv*&qQP>>7$0)$-8a=Pnuo#-hIC%Ja2&_&*c--m~hgj zm0~LW=C7V_LUq9z!f=oGL@o%05(r7vhR=jGl2JZ<)9iQzPLElfz_PCq#_Ur?? zo9*Z8%gFg40K{}Y6vXG43q06-IBs?!P~?c31)yYcH&#)WF7&J*ThfEjCh1N;Rr^v~ zs9*~5(~N}BurebBI<}9ey4h??tC;AGa(;S{;nKPL6Zp~Fwlsfnm@{FK=Y#MBDMEY~ z#h=8*PuyY7<5u<~o(}&5?Up^_S)z-C@MIA`Ds{Q1SG1ItNeLotM5>%{i;eul;f%$X zv|>4-0HJW-wpLM2&2mpH;Bh`I_Pi}%+We>{b%!3+S6D=2HKusvsa>9&K&vF4+ zspmQ_*(*G<3#E32ri|uFKyzk=$0mvU+2`L>uhasES?0Ny#KmQr=+u^ZEbYY^oD($p z94pp-Z#>8m`8LRz;}&(4f!t*Q>RW|3@_76rVk zJ)cI#QBxZ}3RjgaX==kgi4jixW1ba41ggvZqE5L?UiD?U27utb!gnP?^;o03HEfN> zeMX~gY1REm)>A>~#KoXh)m3p3PQ@C}A^~Hkb$~Ndom!`J2QFz98cMutTXre@YgUD( z*$I`NZR9;zN%u0HW0jt-WpWeE z^cPa5Tfx@t{vHk+srA%Ly(POe79{P~nR$v+KkfFE)0C3eL7+cSx^n`SI`~gvr$hzR zbV%*o>v>2Q9bD;@NzAPM z8Xphs56qIbjB;=y`H3^$#v;n59T41eZad%^uS0hLs%xFtcRZVfRM#HTfcp55=Z#>T ziHwcx$Jp_{r>e#O09euIo=^GIPxKW;pH=ZRMmP5f=vDa_o}*Im!lRzo{s5G7sH-6V zobYxGx)$(=9{Y`F541k%ThB8D(2(E~mQ(+ohr^)K9M=z?X%ZJgCl>zfAq+5I^|E4| z@?R0PR77_xu*g_7EXmgA%CIPPhfVMqG(%N9fWS>l&v-aCx3CX6^G`MpbJBnJ)N5|h zF3h?WWAoxLOE4fK95H=p7P)j>j>2$jpBjz8~3rZlsyHA)ZYE$ysJX;?`+>lc|v z7mkZl)6pV=NAQJ{)Y+OJ`iG%8&&FhEoDVLwCg@pnMXL2q2u614o0Hhx(o!1o4;%VA zvwyR=hha}Rkoq}_OuYAu-aO$$lNfiDeH^gmQdPLy{)#o1HpZX=SZgNdZkq3 zjJ(ncm9Mh}U1S)x(!8;>AqpXQh+8rk~Xz1TD+BO{I;EjUSxK}+m!jV2#Ov)QA+C2}BOBXnbbYmYyjrK1O7e@44dh~xmv z)+HoR!o{4}WyF+LL?P7HvDkK;m(omEhBbuCuna4i3mO3HKN;3^A#C4eSpV|R%urRE zgN#`}(ArHV1Y5QYWLhcQqeFBKewR4N%HqCYkYJozHb_G~N!VGhgkj{ibQD|fbdm}J% zJCoz0n=ZE>DE?imO8rsg_pmSnhc zv~^8LCcC~L4fQz{qb)YK(SjQ+&S352%ou0QleV9@(NZKY91q^g;{+>4k5C9B1i5@8 zR1np58R~3$jvn5;9IHD?TpEm_`jZ;NX>YlHCLoCR<%tlX4c{YN0q124@PW zz^2Km7OVSC(Nt^TA4TvcI{I*^>B-xya@heXM5tm9zCyhwQgY4h)=-V%s1aj{`5-_3Gp)({zm`~GH4(?fVALztv8K4h`ch%m#PsM%JcWav6q*PT7r zD%JV==zP^9@n^f=nyMSyT-9zu=B?P*4kC2FHCpHEs`I&egj!|utXK-7eHgCiF<6<- zxOr9|L7lo z`Rg9AL;-U3Cmvh;e5h-h({(BWs>|orcn$7YkIRG_x{EvflMME=qHv@nX#V=! z3hRo15u2{idKCu)&baEfMJTX0tuzR+L6>kE$LU z*xG`Hw47P(|BiLbwboSi!RuCR*`uBap({=HtyQnp<5BR8MXn#GbMXv%b=*wVlD}eM4DQ&70xkXSUbWS9Y+GLK=a72m{M)vPOn<(o)2plv{(4Kf&|Y|KwXWb;wbfR) zy{kI-S&AT9((|xAQQTarAkBsyJ};b^jiWD!5Qe+Y-z{CAWqoT1WSj-gHXK-zA)*HDg?v2Z6K2xP)^ zGKc#$uUgaCgRYUc__;XQ%#iV#^(}9@*2o|@*)<3_t!2833YN@ICVvplA~V%m{iW*Y zT>(KOo%ifa>w-|0z6+My-_N*nclm|MT~vr-u?whau=d~_P*z3qUq+^^x&@EOeXrA5 zRs%#VZ+PAMN${Nb41}P#j8L_Etp$9(a4#r~mxq=!vi`|(S@El40DRLb6cFCFkLd|} zL3(1J1@hwCT5c|R8}6bj?Vt|6fUjceL2Crr=N^PJ__I;VyH-u`KL0)5pH@5H1M5z! zWAACnT63EWf2Xu6RdI-3W;&Y>`6Vv%eJa1oPerQM!n5k$hq(?^)t^IF(!JP`KG1T$ zem33+MYVi41md&9A{r!co&x;D8X{zo4O|~smYzMb;XwSxg1%z}DEPn{4{t@Wgiw57 zz(*PtKm5q@+i1o7(m_=oVTs`A7%z+YqgZ|Gcvy=Q z8HcrEq89;DKi1!AMJGZI7|H!u7kb;rdY*p#v7XpkIf(y6i}HD&Xd()sLAFZ*Oo1T#O?#5ChmBnm|KPX*o73IAnWeL#{D7kf56 z+D6QyIGh`w`TTyx2)Xr|yM!OH=JOeg2_VD~D?(GcP(BLMS0M-kaEZd^pZiXdp$;E` z37|H82J0bU%V(Nw>d&h_``@2mhDa818c)K8&otq~dQV?Jw_-K)2PhFMN()i+b3Z>f zB1Jccbx<#SZlwlB=-}hP=M3LaulEbz`cjdHr+s3w_uFL(N}KnuH;RvwQl&0;aS zegTK+6dtp7xXeFnvH)Ju64vF9-r;J-w|bCJp$v2cu*PVUVHd_iCP_r#=a(V!zJt^e@J+sGJYkL3!xqdcJmOroWDUJE zRq#E1tN2c14%G=aiu@jyFXP)yRaXMrzTaD^B+vL>VC&>H06zViL$sQ_-rwk#(`d3v z{K1;U7qkWg!9hl#;s-6uF&`jwU%--g|Dd5s0?VjV;~A)_91&jrqeX0NNa=`p3_OY0 z3!-KQ1RPl3^WiaNKU)=Qh0Es1yYIl;nxCzyx{Dcft?4rKP*pt!Vw3fYRsM(f0xfa5 z!f)-QRf@}+R;h?)iY9*&elT1T;DtXBy}WKcVZe+L%;u@5gi5NvpVEk<2P!E7H?GCi!Shzia2)Zku4P}dXGdl%mIqAg4 zInC_Qq$~*DIr_+&JVjryaZc~(UGG#!+Pj)5BbKSxOVReFhJ7aF+Lr3l^>~3+n07>@ z?6XVdb9|I9W|9|oA?tAy%guzez@6)Q=d5XeFZ|_%WzRQnpz>gl5{+k0k!`;c!s%W8 zV(fQaV;wWr9w0`)>^NIHDOV=gmfj34h8_uKAzw-Nk(+$sF;0Dgjq#a{-EHj_uE=o| zpU%6J%9R!w4JSW|9={VYne%eAl+!b_3VWZq2Y z7i8iRf5GnVn&ABPGW%Ys@I-gJd)P%elsTGg-=?Wg?B;FM&|bD2rCXZ;sTb#Aoc{2g z;A8_YOaFSeMm@Sd=a<@1TCHlS3QoCumL{%(*7vqEg|Ix;+rE{djK0$TNN4FQS-PqG zTMXMt?PG6nc|_Ev-g69)kG|?_f9J_1u_Niy2f^UHmg=T!TKZIKZ?=Ig?Vf^O-rw$s zr(y5@_NRCnwi;j$G$&o~(PTAafZa3X)|RCQ!hEGwQA8UbV3*6$W7@-GR)*b6ZJOjV zA_r50c*zpF9`6uUH;+Jv7padk?BRGMY5=5P1u$+`=0K2=P3vEft9TAOD(bGX(}~%t z(`We8vj*Cu@lH%j!1p9Ii6t8yEVOQ*9T9S8OZD4wHlm&xXio^q*Dfh|SNFjBm_HwC zSeR+sAq9avf#`As0?nj~yOcS|o`@f#ZVdq|q6pVyXNAoCuR@H$wvC5l&S1NnD*k~c zCJsh!oHWEvQ3N*a$O*uk2itL-W&taig2Are$Fm@atU2}I_iG>`$KQylY1i;ys)LdHpau(Zz{gQUIGvq|WrK89}1J{%o@ha zICFp0^2zy4jm9rti~zriXNp6PWcHCTSKF$LzvDnO%9isw(?;1b{@oF(^6_Tul4=Z( zDq#l zmKlb+GtS=S*(e@M{0S|PaeSnudSpzvPaPj;_m$5AYutpn_#_n3>TT9~>*KUj4oiPA zYUz#k8M38a6mOMQjEBLEx9#ZV-~z1-5TM%ew%BMt9&bPH5d(z;!U?`*RzEz!zCWb6 zrRqNuTV`U8&E}61Ki8_d$?nC6SW&w`l~S!SIF}E(tJA?_u3Qr_8V%_L$Lk2 z0-Cv+qd#b7j#_w^EtUfFZX3IofBS7!HzF<9t@arzy`WXN_zX>?*o>L>6y5P~)wnT< z6Gdj)UxY@sV>pDKCaJu+5g430alq%kS>VWNr{F$V4j<0_8yG4OoT8%V*dp4d&9*yp zIe0%)B&(QtJYv5c6)8MNvJF?2uO?#&+k!k^aSbjtRkQ6(vI`1xiJW6kGbLYZsWt$S z00uYgCVRykduTw7$?nQ3>0F!Ooc{V<(X9lZs2?w=EKfvWZ!!%j^^d7a8-tNC|EnYj z=RDgWZ^=A+_@7s2l@$W;fYmj>&^}D=kwtd5=*MVW5KAEh|92d|_5u5Te3}nFV4o&J z!~XfUid@6@nvJU&3xF3SAqzpQz9sv+INJHTh(o=?1y-2TxFL=YN3%{wNvH_+E}p~=J2eac@yII1+uyN z;Y*l1nV2FKS+ZR-SC&tAhBj0Gc+CDpEm#XXtQv|un|=ixIx&+r^&QCqQT^j^sVY@c z!IEoYIZUKlpfE~JT4$$}CSs7QDW}WZ)c$h&PPKa-cBZT~b`5^o=34u1{In|{=fh1> z`ko4?az!~g8rIq!)!0hXxQkacYY`~-R5p1VrBZlui`~7hvEoZ31n*2 z-bx0jmfc36K$joTb_5n?KABbL|$M%c+L*a0Px{nd|Mg zcy{Z{8!B6#_BaLW?bn1tr#;CKGW5eShvh#B_T;FdC+$AG+4&?$#GB_@6B+CsWRR$* z?7m)M4Ka*daMEd;w7AkFm)0K)!!KM{L->RB0J0)8iesH`V;8Wn!xk# z&8Ic>Gn(NMqp9C*n`ny|N$u`hX%u-zsE)`qK{X*qeZ0x`uat(V#^=K@3T=iQMFdt1%*oiFYR0fQFk%bLuY=mV#qQi*J{B{Bd@LmkDQTJ}1@3E7VAX>$ z>=)e%3ZkHHwfksoFP2Qw%^*kt{Z__^o^G|5>m2e%as;b@!9Hv6(rcE3tL&d6_cQ)d z^~GvXwJqmAEv&XXwAZ0W0$<8oc~0Tlj^9Ln{x1$zGkM<@k&VMbYY{|tf_q(_wkm=Qepf6 zsEP3^R6^S^K>GKgF+*Pk^N|8}LyRzNW7zQL(2`|-Gnl}pR}nvR)PG)OQfL+)qx!yP z_u#(ZH9c4*uh}tw&b&}aUPIc`+>7P98hdI$=4?C#1Kd(WDZ1YxBK%4DM`~?<9Nv~n ze^B@j8qXfA?P|z&yIB zw3?H%ig#%_;1InJbjN{=sLvVrRac2 zpug_1Zw!LoxE5ns{aet|s@-gsU$EECKhIrN+Lw`*W4tLcY6rFKEvT6;77x7M*ho&k z#bB_yzmJ*HK^5(@*9WLmWmqV!-LHjug0lt$yTbkUbgzgslLL?td%8>=MBW2hy7eBg zahU4B?kgxz2Q{P4{xn*f1p*m!)VPBhYf28ciE}m_v?s{CaJ_4br4#uG1Jphis+Yb? zcLT~yVFmQI<9qfO(&5>$aOGrgypwsz#!>TM$e=62d``{3&^EQ%kH-CFh^oHY6%#3| ze7f$^#!@`zKD1xZT2C{T{Yj|h9R8330t78PBh=ENo8DJBAKBePPDiP0j#|FJTf{<^ z;Xkr>FmiJbqb2$2d|Dmb*|!|l1A5}H?e{PEi%JVaqNwQvi%$R8o)rE84PsAiMm&pP z9azVx``8xO4(Gd%ZI8eDmI|vktID4;=TEC~pF$!)oKI~XbM3&V_SL%8_@%8tSE|^= z&gJxaW+(!8JzS4iBlQ|fOSpu5*s}DRHomg!Vh~V%zYQ zn5-%}Vxs0_pHZ6F1Ic1mOfzTg5&JWOVyL3e8KaNH>OX+pK^Pd?a=3u`h20_K6LjQm z?5obYtsN20zCcg=)Gw-3trFSe5sVG>qN5T8RAvi*K`MDft^N|(=QFkcOO0&NU)f`H z&#)NHZ`QW7rV)pW4Xy~M{43@({d(zZyR#OK{4N0n&nI-}%uKtZ;Q!S}?H|a}?--Py z)uwNd=d_@y%nZ7hKDZUGWZ&4k{c&XQd!H$m&Ewz*=U4r<#O+gci!jCG+#gl;FcypS zVT9@^{3mAM{Ns!#+m)(Mz!gtBAD*x|CYi`14NwniIv+i&>N-23><3Wj!bA)eK;;YN z`jNTDRIdU{vVO!G#!BT*?vMXy$Ljehiz0(ntt%$3G!?J;+?%mvrv3yu`clpP$zIN0 zD9j}Kya;&Ef9wX1TS)lX9>`uO^#0G;3nlw>w4m{gh&aUhXiaeQO~2UnF4wnyc2(a9 zBJ4SZek=UWONBycj_WNtWxqmVPCH$Hwbx0{_Mb*KB4W*H>9=R4|v4pw!i6!j2 z3!cBf;JM*~=f(@3e^8r$1J#=97}CKXRrc?J_Fq(5G_wRodQyMW=Lr`)KcotpdGEx;bEKJ9mVc6( zd&jiW^ox&W(MSHIL9%9kkt$gmZfQ!yj;qtS5Y;5w5zg-B-WU9)1Xg@U5z4>>j2U(~YJUO6rU4%U;%5fA_x6vr9Av*Nw+swyTf0u(rx>N?|>ywCbCzsV&o zEjG{!spOJC!M}4K|0n5U?u%26AqmJV@!klR3x?xkmy(?165_wFiudNSMUM11*|mo- zCbz1hifNXW;7uoHNJ)Zs6qh3j-s}8NomFldZ!hi-_Q00mKR2q4cSMr}LrqHb4h^2M zaZvW;73Z{!!twh2eWcvWM!JFlsG;YNtZUIEPgIlpXjPKv9na3W6N%nF+F~$TWsJws zsOB+b!NdlvK_iG^E_CmvB=6O(_toYk%Fj_pl0d#3e2zI`ge7dUDhsaV^#;R zP>Jl0UbGVDzK&iN2Ow@;5LmK0duMUKx3kyrClUO{adq{M3e)HrqPnIuLl;Z)5&(s1 z=TnWvR%cc99I|Iknm0^$c#O*H%m!&4TBxoIjs|s4wTW_!%e=9!NDoc)H#x1lx0|15 zURWsN;QuT%H#$7*#ml|$lpK|Cg?BlZtyg%b=z4EdX}ysG>sLe&U!|uPH(H>2IaIp% z2UMlvUfvYFm;!*Xr<>QXm{QlvJAq7HdwVA`JxY3ecL`js@8iXh0+$D`EJCRJ`gtGX z;_B~3Du8^@ylouqklvqf+56Jp`>o{SH7m5~-h9%cGrXmK2V}QuoX05C4D{MsprQA2 z*7rB~!8VYlVH(I2JQ%c#MvY8wyTH}g%s=F6ZKn6K0F5YmDiP_Ss%?rg26=}{Mz;Sw zC9N3DBw%C*16xLPuve({>cQSOXjR@2W<8JItG&-@R(uVONmkiqZDPv8FnJxl+AC7O z)?c&Ux6)Pq-EATwMMaec;N&{o+fxga14<8$19oFV5lM!FS?H#`0+W(Pc(prl`;p$^ zR8%n1`-{esmi|?=^3_%*3whW!>aOw5B*UOl-YHzRj`I4Wq6LJftVSGn8%BXH80xaT zZ)>O%)?^4SbPZWvEi<&v_Ff!-UK83Ww^DJoSM>a?+1}sfa;;Y+tG(BH^)|#`ul0V$ z`MAZ6a<9ix}~eAJW7FX%CaM0}HXlzt@^3TfK;S4Vh78EH3rE#2EJRT;-7 z>j^h|Q%PQSGt`T<(VL-twrYIc7gH)n#P-Vd?$Gj)KT33gkM0|J-j4ppAP?nv!y>&w znxJy>7&vGOpR1}oKW6`$=N(MR8MkFsAyp~p)_0g zSd7Yh*T*u>b7)*$CV3-ttM5{-UD!KDO!5*2Rpm_rAhD`wk}gI^NspgQ>sqNnlfCQJ zj%na(!({JhM!j+h^SkCn_FOeAiwTPsfhUf3ivYyoOEY=7=vHqcQFb=p>ixx^|4y?_ zAO~ZrMI_FBoyveDs(w?wj|YfJ?WlOc*~Y0t@CgI$9SBdzD<$&MrrW&7g@&E0y41KK zf(Si3r$O-il<3bsc8*NvCmM!7nwo%eX3iR=`}9;u4*nXZ>O3-9%! z19X@c z=Ss7_!ch1C^q{|rp3n3dpz`K>Q9meLs7}*5f-+#b$}WP+HLc5%AVx*rf&V3-U#0d6 z1O{qAglE!8w<@@lK>S3&X z5P0XPLl1hBxg2cGW`?W~4AiL)F=2yyYtCLzEtr5oqI+}f5bw0Ph~q!KWA%%8 zRhtIk%322cQ|dBrDK##B#OwDvmEOtd$|U!5%Ds;;GBjqn_i-*emjm-0WfmjKu_93n zQ_4|k`7zy{#7B`_{jzC1Xc-2lbe}JZ08b-*zI(&7Wx&p5fW`ZKhAFrb?5B+2waOLa z>qGVZVtnJnuhV0$%dCp=^-$a6eDP(mJ_-Jm5$k)%b%R`HtC^RC#wU#-Z&R&t>;=!` zoT64f+)vl5&8>YKi3OD%=bJ(pC@#?7lISp}F3uMb=9-{BY|D$gR7N6jAhcehZyp~d zB>6goXMkuCs`?&+-{h`C^vg~1?FPQ>+xd_<<$wk>i493HPJXfvZR0L=UyAS3K)UI; ztd05YePKA56m;^9*CIecU}Ud$*1Q$-jLTWj8F0C7#^r?;xN@CSU48F|(4vE>zJcLq zDL+IN?1{BV>6+&I$S1}VVew7XK18-Qm-#O7wxav;Cx{~g^<7+vQG0@AwEW9_;sv|x zGT+AV36f3K?q!4gi0(9wGlH{w(3=UWsE6;mNd1}|Nh+xsh}zJ@*M(OJm;1)}+rTEH z%PDM_v-NUci_maU6GK*3!v}M_heqhrw8C2W2$<;`P5wc>eFJofvLxGH za$PvJME3FZbWLzF`uI+Z(A%${uPtBX^z-!z8Rk}N3&MR)RX^WQj=E8&(m_SN>^R@4 z%J8wv?yNGiV8}J&eDNxGwC`f|>d@$Bjxp5tLTLC7niQ)tUIHyE7U9NIJe6g+il<}H zH@`JF0eFPZ{)0=7kjzPL_1l8jOH|N|cRUzWxBf?E$HYP=5AZGij zuHqA)<6EQ)L}r=f2hm{Xs+)Y5g}A2b57;w+Bism#yj4G=h^ODj%-xa84BO$H&Gm5} z`VJ>&k`J!GL!F&WKX<6wTYb-PnK8w;O?o@khvvUSB~ADJqAM~~V;SujF`JgBf9s8K zvS#?sgp*_B-Ao`E4Z^b~qUJ2U8(iAKapD|fw(o9V#}FQFTNNGW829*I2n&D-b2zwk zqu40_cELaiVxNstE$^{gJBhP>eSy8ondj@wrSgU7WX&pXgH`&TBPFlU_db_`KIlh< zQ+&3QTjV2pbpF*#cUE#Mgzd5|~R5QFh*D_P5sc~zWKGW5*wL;yT zV{3ganiFO2KTrB@#)S*v1oAx%3v~WdzG6bnxinox6+B@ywxN|rOWa|A@ zr41nJPyHs}CPewgn|<$c$$1*g!`%1`TtsMDk}6>5t*ToV5vC&t3k?*VLUfBDy-QNr zM=ihU%O60)Ir9tyL1~p+K}3Iy-MmAwba$(dGhWo(XPM1RL5Qc*gaLk4jy|t<97Ilgi>JTYd%Z6 zmfjHPy?AB{2=8_FzUJ%D%r(mqY7t6YKXWg{l_h{TDWCI&_rkO>;TF?OhCxo-q@I?@AsY2+K?+y-QWBpR(!zMsj&<05nH#u}_L2;BL{l-Np`qIB&^^RKW4%7)Zyn{V{$rdg+WA zjl_vgf17g;ElRD1Ufv^0vKW1aY|iJPubk?*ZXE*3-VU@#CiEH;nTSLHODSvEx;}HKfsr*(MGcAv+7fZ^+9#;)3||p)rlvT ztOIFsib~rZXS9=+H%kUS#Z7z=KPhcdD|OlHCZPQ^z1cpGgH#H4$IZ4Lq7r$%*nfSP ztCTuiCG3fFbY-$1I+>qaSVttXJ z;#Q~qUwLG_mNx=DW~$HPyn3WM^5XQg6ny5NmS)Lk^yg7HkPG8Gs+!LL{Kr(rzPMqX zThV3#O7XMfwi$4C=lS$xRP2j$lBB84lFz7Og*vt`Zsh-2YS*)u+AR5uQdg>#`{Q~x zQBIUp=EEj;DT!_rS9%X^4SE;z-;fKf=zq z=UhYOd>7XbJihX~IMJ;g`;NwHa;1viZwq;qQ{q#sOsmz#@8c%xmJucXTREWWWL#9qBBE-HJqil)SDY4$h>*G{2qWn+ z$oKEQ&Odst@SNA0*eNjX4Q{z=ZiY} z!yn_?N{4=oGqkE%aA>mfv}@yjr5{O>_3M6x5xSOneD1W)ZtbGlIHAbeZ?Uv4jsSRC z`JT}O-sfmtT&g7=TP7uN(W~DrjR%z%o*;_v=!a4M=ln$1(Fy;=5Tl^{2_lX%^|-!d z9fwjOJ06d_e{MNI(o`_5IOF;GGoD{K%t|*|O6C5cU*mfFCnzZ;%FuqeQjteR*F$Tfe#75Pp8uihyl9P6 ze~a5gkl5%e4ac*I=nk-~{eF+j_q^iU@_Ss280o9)}uP<*V$h8yC4IIXAASCytB z*_MYJg)}+i96I0+=P~mfV+Bf@v}5qP-gAwyaF(~6YhX`lqT4Jk#W84Egb`0--dbdz z_+6&ov5_$j;n2hr5k`pXsN7m5Eyry#>KOvJVwyS6V7Hif`wUe{(S|tTWkeg|AX(JP zn9ijjAAWv+PAjjf{4EKe(Y zm?!)-=1O1@LBz&jS{p2T@>(02IDn?b7_;~$DHitYw8b2?aUYGd?7XHfKl zBicVtoY9v{|2X3&Ttt~lhr^H=5vJNOCIcJ=hVg>i8+^}ZfDbs0&uk2=DXhCp44wJ} z{ow-3h_H0eNfR&&W$&Ok1vZip2Mp( zE5R5<%wmRu@p z{C0-8O;@)wUX_B9ftR;6#Z~!T*!o(PZ0sj}LwmzDybe`!u8bFu(xX(`5~`U$pdIux zirqBXDz^hlGZdiz0bsoyjWvES{6D{mPBCudo9d&e(X!Rb6vNO{*n?gQxe=@}m zH%5mFx!~${6X5elcfC%n^Nog}*G{Nw@*P|C>S6Q>T601TI20YH@_QH&?B95(2TKzi z)5DkmYKu%|C7^6b^^Yyf_{tV|?*%8dcei5HrW*YSVO?}N>ouwplvMsSrkxq*q8q9i z78_Dh32vL2W^AUc?ibKQjlF!VHLy=tF<36`#e9<-Fe`;=tkUV9hL=Q*RdOD81gqpd z?ijv#|1@5f-2MB2Ch*xKB$%q~V@%Z^p@BUmdMezgznK@&DLha|I*BTMG>s~}2=Opy zG_{lLf{sN85d`>~zxY2>oD}{4HUAFsOEW%{W^k1{Mh5*uO&=T^87}%LS<)X# zH~h{oRZZ@zo7{iw-j_NkD>wHCBbGniGckkAlIA!PDg-g#qm6T!hz(X-B!x$4P%{fP9*g-KRU7&fD z8Ag!UxJv-hZLCUP5WOFJ58{Y}SW^s{bG(MY{kC z3nQ$|75t=&GX7r*NWmEmGGcWez4p(@LjZKiQ#Htl*W(sw)FJFz9Av8Z9)IoTiJAj9 z&}*;}t6NVwx^>^km=97pPtvs&gAFrWcbAvA?svoIv5F7y5M)rB2xNg;4vQ!;kR_Qr z1mY~XpYxSD@QReOA>fc~Rgb8_rSnjoZQ4*HQD^I+qTj_Ix^$??k%wQv7X%tULgUV~FEzcMbIK<0b{33I%?M);U+1Mj zcT=M^)1zrZ?WKn7_#++whe(aoJQW)=l1ch{r14RA=|nSJ0ts(AIpRHl&Q_1z5#Pa4 zpbTv`CKOj>5|R8jvj2tMe;__~udB_M!CUNBSxa%#omm3OE?td`I`ML&m*+ddn~9$9 zRmJ5XK~Bet0gI+{AT&(HkW4Ud&@s#yVXeBT!rQ>APh}bTgq(+Hqx*RkApKp9_!lf9 zT+_dRF7}Z8%SZ|Ov6bIXcbBFXvXGKg^*$lFV~kim^pPq{fyKRJjWF$UEnq66Dui5C z3ix%bv9^tDhJ>5cuOwM)Nw^!;VGW8H2TekCJ_Vh&8^Ld!oYpta*hT8KS3s|8RmBw` z(K?qjc%KW2@ciU**vH+=3C(Ex2486$^#s}9`7XH1xJ(Rf1y{pOpHxW`=ox-=pdVlU z1S8es`9)PsG`jx9mU2pM;TY>u`!+lUGJRV&-tshTu))=td^1OFDtL&Vx;(Gg@U zBO|_o=#-Py#Gz~xt~`ng?Qk{#Sg$%?1NZeO$E6uP?FN=|FFMaf4}^@TEa`tl$sV$y z9*;`9j`_%$1Q-RW+*~2pL9DW<90sJSHzgO!&fS@P<3dXQNfqUjjQAiZ$%m7SE^1jW z`&0ti@A8DIqSx`w(?=7p=X(!UkIm3-y==GVP(w>~Fo%YRNkzRmB8p4bqC!`PaE_aZ zKWVP8y7y7p=3F|@Ni}bn?xvHO*>L++(Xh=?|2Ccqii}d9zZ2WexBuTpCl5}7y7s6+ zp<%xEQy5OXR+x|Q^SZxQ*(doconq@1}B|(^y=kn;mxDefoqwzXc>$Y zwdOy@B2R0%ABk{3=Q^0oShe*!&_ElNHkHYm%6!JjZ6c9AvZnIFl=twhJyJX(C{~W}b5i{Yl^QRk!IaO-f3(@FtGqjnF$toekUzb`D8b}D zK&)5$4&G_p8|3MtuD#n(%3KOuM9noSJ>69GT;pCfcm>j;_fHlPY;8V*2rfGLnv+i} z(9H3i0+#;yQ4+w?R+R+|Ko0~`5gT47%6!Bc5}q@zi)b1? zrWP5X+oq6C1dwHuqnz#Mt9{jAUpG57UZ?EdGW98{@^w#qar#BUq$kRu_ z4e!{kMlUt~Q`)6Nm6UE}Nnaf02J6Uq!--vD4gCj-eEWxhDlnf zwGB*-aJLOm!a=j~iLgf7m|V18e_a-WHIpLnF z7-qbNSTIJ(2h`nPMSj4{BKv>92P4GgVQw(4LkSY@%*fo5<@t^&q+jQ-fTE?P)g0He!##Fg)3qd0sZ;3kh9eI0fh`%w5O z&!+1sS^UrQfU7^1VovM8Bflt~q_mXQ(7P`c8hv z&?bnBv{(g%cMll;0>0-IvESHzv8WH@cpXp|=#4=BPsVW-vxuk(B%f>(Kb=nvIAFx- z??p*^I-Ljpq)Pc-IH$n(!tS5WrxqVDR)t>@=(@V_a|XPlTKGBZV36{BL5~i74wHt4 z>kE>Gs3Bi4plHXBVi(`D!=l_x+~dCjJ>1}1`ISs5Mxt+x6m1OGu&U~IJDiY|?+xR#Io~q6BYd3? z8$Sl&Y$UVcOaI=O8Kh<(7pDwQEP!){%ER|bl zyw2bx{bcxpxd!9eRD)Zy($VZCqdEb zLd=g?xm!a`!3p)D=J%}EBQ4C9^x9X~(u7*ntNJkWVbwmt)H4#n?i14#e-w=g%b&;j zAm=c7y}c9Kh0$$6jFm)=!Dwwp;BBFskiG?WWPfXOxXwVl zTFD@xFxc6JB_+lz4GNb}ML-#fU5GI5QE}!`p+$a*9BrB3x_Hmn&0WyFjUCLjL0UgEfF=q$ayu;&U&&Huu&V0B2|IZz_i0nK z&qUKhlhoOaJtH()T4#ouEx4(P2BEa0e1)CO{7A@kbZ>KV3+*%(8)d7){$^~p42S$l zJ#sI?V&Fc=e}A?$BWvSk@=IPJ5MpbR36u0${&XnZ0Q0M$*Ak(Zd)wG6q9vXr->eXLqE!mPpN;)Y92j?$7&AH6HF35AI`a08`z!{4fS>~+J|B{I_f;P8=$;vY4!6<>xLsafP zEpd?2`VgZPlbHd|FS^2PDK6H0 z$zI{B&2-OQzGyZJ1$pKO%H^Pux1&Oey}#hFnoYM|Lqy3ta7ah9wc@`%+eCNhOS;B{ z-Md>8LtptMvr-3<{I~fGW!KFXo^-O=>8wpqPfj)y0Rm!45?Xy%I1J}x(@R#*6w~M& z2FgiXIL+8WVm!Z`~Z#Q$PTItz*AyX?>a+ zeJvw`?(|yS1j4<-d&wK3x?F4a)%tuLX}YnDg#Va5dCMkyM~4sS%Nv200F0%ng8%42 z#zmdM`^tm2=zmz*d~@JBa}1ZXsbIYSKfS~GbgH?GPjQD&QTfwk{$wuM^fQebIN)TO zxs%S!x&Cx#%J-oXdG~t#T7uk`1f%Oedc7&T+%*_@r<-^2>B{KDDznjhR;dA|~4EOn)HDbvSz&w1jhLsMp z%-8wy>sf#^z$9UtX2+{T#r$8q~@W+4bD`*u@>2YN769bAdYE|UY$l=lwk2E^bFL1!xZzq(#s zii&bLM{KMg$VXXs@=?B;<34S^P<$Wrsm&4}}ev^O7~0dSsgCWh+pQ7W${iGz3E zL>o~v*F;^?B_zz(?>=+0C-hzyb@z(K73*WHBjy5-A-2l}rr1BHEihjXn(tB$ages6JCkntQlLOWZ>A7ctD}l*LV5LQ7dkF8#8564pKWm!BwcZe1%QW9ocpPlAez{o%D>vs+6a5M7(n{DrLMX2?Z_`|o z5N1xF-cEGV{J|WiTC<83Ax1QhDk$(6C68(4A!a@=8JG zbU9!cM@J<=*-&FX0e*eRB}9c!nCU@Diy6&ysy*c&N!@eqg{HV`x^4|@UYgqYq&X}} zw}m$W$@wqOzJ&jo&joQ<@Q$b8i9~T6qlzXFhp&8i>kzGf)ve|9?bb2$T#iv;+Z39! z=g^#uTBmXGRqI&V+SZGizk8&M6HsbDEyPq671)laP`INzc{=d4xt2?P6vuvT&XfSD z&zQX^nDaJ>)&5|Z8b3J+9g#13z1cHJBFBlIAm>?Aj8=Fmj%j9lctq5Da*#2KIM(@d zpoS$X_c^l|Ghk9VipbOx#LGDR9IY&o1ZG(-u!H5y(=tY~liK=1B)Y~HDCi2y&9La@ zeqaq|&_przs9IMJToVkeoRzdf)k!HU^;767@^XBA!?^}W8edgmCN?ullxo$V%1Mon z;*4Wjh@r2-Z13Nn<(X7V+ln>9tX034tfzw!JgK%uD-j5_U4&l}V6$NY_PpTvzdeL1kva)4gxH|PBh(+I- z8v}QJc4Jwwca`==N~VbVU5Ejg>Ug^dd+`*U52Z-cJ2)5 zTx5Czqe?ZJZJHcNQw2WLbrY%-rxd8NP7t?C$+;^QD1 zWY@p8FpYQ|gI@;S>izkI_B);coAEL$$e)nDs8zfwOm#SXev_Hnti>X|{e6qGH<>;3 zm^W*hTDj@09nr~6bwbkcH&vY||7#yaml6Al>F#oBUR?GoFc^Os042$-&n)h(DD~Pr zVyHg#3RHfZI|@~=u#`a}udu}5R(Y?&;Ju@^y=q>mZPPM}(vWxkBlw;yovumm^C$}@ z(D^{N5B%A-i@gD<<27{OrJK!IYlr{EhyLqFTs4fT9V|ud*%#1-Np)5JY}Nkj$1-s# zs@oPwYSU;5gM@&{trHD?Dc}^eg3rl{_6oLELnAXok{%MpZ10STI0T($vZW#(u`G0 zUN=WYAM(Hb+JF5tK9=f8e06NHW|B%!&F>``sD!7m;`d|~_0 zM$~}6SQ=KtA6#JY780v#>{f{TkLr%C=E$I0bXRuUL~J?Nm~An)zZnu{{X|v5e8{8= zK0ofS`h-e*!|dDPSkKb>Jsgsqr^|kwSVyRrC=K?|COw^w4E*!F&Iqw!FnEuNNg8l0j@R z%DipV@TW@J#_I;ve;ecIXNKOrf(UrESFizl&o(nvQ)~P$ydmte+(fkQZf~2ZLH~$W z*Su{GrA1G^Z4L^;qV?U|=6?Xhtal*rLEuBe2gFAb@8DiB?Y#qK#p~uBDj`zlyJl}~ zJEzImT6U2btKmIFrE{IXNGT4X z=}%DqifS|n#QLiabQv+P+FU~uANm++ra(pRH2a1YFlV7E??pNAXeR(vpz?O2?7B}K z+zJ2kunOPBG(4=bLhz}q3>HOVh-H>!6Vop0IEc@ik4MphU1mAOUi69i6$bxY4-lF9 zso9O5WPge@-j>Z3!iGnyt9P5Lf?7nY-*%h-IZLzi_MqrtugxBa$6q^DFI&^2_QF!2 zF}(w)0x_4VyEcSjJlSi?@o{RvXQu5p(d6ca5FIQwIOHsXRnceWEDF(w+?e}JuY7v( zKJ(Ewf;|OW4&oQ!e+a9w&rFF7yc)(ULWP_Vp^3AfQeQ)Is>}}w@ulxa#WJ}3RKR!8XA4VlwmaB2=C zLpHAWtB$Y&1=72#gXa)GZ~YN-iG-2M_#PONm5C3%7o<1)dsb7lD*N7)NIPjq{UX;; zRdxm4EhWgB+J8ZNoGp%`ENFDs%o^`FFC9Y{?eFfv{fOSRKOo72lcx}MRY#AGQR{vL z&t$8we>4+ykPra?j^``1)2ZF)>v`&xwdtCHe zqqzT4qvR*Fs0jBzK>_{ljHN#@g~+Nu!Gs~Wxjsu*9Y+QvMA~t5wrJKQDq`jd<_X)v z3Fuq4Z_^17pTsh`66dDcljc!eDYAYsjqm_SA{71%KNlydvdRj6K~lu%9cL3Kst+M- zyyJ+ylzGaWhp&Zvsd8RNgCZuTvmhBz5YeYT3ybij{tD*T9s0NO?0{CT|JaQ3&HD{u zIxwEU;c&cSBWjS^KQL3sJa!_8$$5r4HCqm0_OR%t)}vS>p2&@iU%#C|VP(A;tM_6E zo6wF^iJ^_P^``5Y_ZKXl%(oCiwiNy;`gTII0sr;B9de2loP6)I?Q-fN3+|`Qrg&VL?=X46OI(Z)U@oKUs$ca|xePFaz zr6+*-%#;pL`B3W+CcSMfEUd^{V*x;=Aqb|1S+4FQMDIbB?u1#QBQ6VrY7X{o46|QNT`w z^`@ZzHzKVIcsvIStJ$&sG+Y z?VI0)iFA>7^|xWH@_mK zeXKP$PH>z-qXnxmRZuu6&%yrSX2B4K+Z-_R?FI0rhaar9`fK; zxV??lUOM_y8~rHzXN8daAr+m=kLAFs1bOTsuUH-QD% z3DY7#t?!s=VVnf*T9()?ESs08oowBpEIB4=s%?paW~FWQy!8Q}yE?rDD@U)g2vw2L0X1s^HF(vw1lrALCs+e=bJ-6l~%lehLMf*~waVc63L?;LcX2 zr?YQPXU6fbTx)d~>&nvcVc;Fg5&qklmtg)+oaD?Cr)_oKJ`@ z0iW(xADpqS>P}LsTG*Y^v7>May@2tK)PXOe&L>Y#HR60=zZa=ds)+2N7X~u;D$lpx za*cc~RNa#;(CHC*uH?cts94jiqhkKN@tX*uU0h&o_u!i}r1B%yhkj74ds6?7oHUT=??`_63^%M&||DVpr1`LP2DfM(l^S*gtY#nzxuDJEPFrvmElZ^z8vhk|nd#nw~$ zjYpMLMH;@+zRbZ{Cb_;Jz|3BT|JZ0N`m^LusyY2>00-Iix8}lg^&en;#W|Nr1Fc_l zc`a4-upsjOi-WUHs{ZNLbF|}FIt%jRCUiA5!;-x~^E0d-TB$AgDM>|_vFNHYtdO9- z(Q4J}i5IJ=ORQM!2M{M2_+7zI#v~yAVD`KO7{U4J63gA@)KV1-15;9ZS)=h zLrJn6o&OyIM12KCD)f*nQca7nbfEQ>=3 z1}tuQUdhi!{7e6`-ty@4T4c=xcrKvxys;R9YR6a+`lSqF^Oqg}W}2!WM`xBZ){4;Y z&n~ZY9^`M8bR?LcbYH}qvr8__QT13WMi=-u!paa|S_5T0S?c&UF zkb;R;i2hbK+z0A%$FuERnKbFAFk+|Q@xY(30OR=en%l+Tw>)a%twEyq&Njv=I zU99)f{9Q&7MFSQ8b>0f*wu{mIYCcEmU)eBL+Qo_OfpQ#bX|}Zpr#DSOhhJk2W5vmLG{+K29_#3=&~%wR<#{+b zS@p}c4n>UMS)|ZQxhn6H#CSFQ-&U1pq|cgc?GEEwH{BW&O0=%6BfJPv*=*aKl4or` z2XlVXU2q+&G_Ih*d?&;gcDL0n9M1c~`>kOuxXyXV>KjhYn@T{AxZjUpH!U&Ly@WL5 zV3KlW&BGf{3t5@Vtce8w+OQ197ay->*1Z@83zl0C2A^{oEfXc>zQ;GIl+fN;Qiy4&1VuC$tO#1q_mI@b2M%F?HyXB_o}HIr9cp0Hl$GH10lQn#nI%D{z6<;Sr_;OJ_o z6-uKuWPy)dqZ#j_6;4-GIy*LuH#aM96GHRFHaEx)a^5I1w&5NS-#S{lQd ze`}#20K!_!fOh&`S!=ZjfwFCV28tqrSqL$<+sC}LUW-4<^8!SwW-~LMy1^PRhtQA$ z0eub;1}De&%3-#$)Uk5wF+%^N^D3>dL~kaURL(05$&}||=yZYzxfr``&S!YfzKr3 z(yRJ%!>f#&#Ao7wsPhO_wEk7thHSNoWG(`QnmtOP%p~P`TLL?8w&L;c?7mqSDg*3e zfYa%XFX=UraK`yMzYZsP{$9E<1TpR~KdIpqzgt1{FNL9!fr4GiZwtTO{JsoV&sJKG z;wd&_D~x%wMIlT33OW^md`7&c&2In)=nmhocB>b6F=yiL;H!Mo+8=~hsm3-hzinkU zb4V1b6_9ylpi>p$FA*6&AWT*MJ1pBr)q!`I+I!W>cdW^pzza2!&%_hioklh{_fRX| zwGMNH0M&YZh{>hz@iB}2J%paCX(M|w7NHZbJqK!2`o49$UJMtg+&9sugI>Z^zYnb2 z8Q6^<05uq_w}aJotBPIrNHuc@3w5{JxP!4n|2r$*C}|hW_UHCMVfu$wK3{G95CIJV z=tC_(b^eHvnxJm^2&NDC`^b_VXd9(rV9;PB((sr#Rrr)QOvT6ISX?^9 zi3O;VKDMq?Id6gx{#f7I-Ex)6z{xt0YHmj+k5y%-0I)wkM#y3biGC(?C!oanH9M`_ zFk^nb6Zl-MM(lzayQYZ($1B2XA9Y}t)l+2_1ch`D?B&!m*`yXRpaiB(=vL#jt){|) zD^SdgG7u7`e2OUYZ?*DMt7k|zjv7>%Guh8l)eE!5`X33;=lr66{?z(sP|IJ``Ma&R zLnrBZO}iZb{)jzRytd&8t0o9rAVhw;Dgi9+*@80+EVj8X;nXLqvOSFNy()Syi*}Z; z`(D^cY&vDC_`ZlGr=Hz1-h)Pv8Hg4R?BXoVke(mT-F_|-_Z_9 zk`}Ud^{fhi5E$=3=W*Tr9m(Tplob}9%b>aAzw#hVtb7`-J~_ymo!8oqSG9E*#LBMeDT5YRlJ5(s!!+H?ZB4UC=9i7h$^m8(IZ*`^LI0e2Rbp zUl{7(%jZfE8U`_ZaGkr3CaXIRvo z^WcgWf*)(P1##C0H|g2|Fc>rH(F4IlNED6JDm8Y*)?53}mj1_|P)LBIL07l1!TMfn zm0GHb4aEE|pB{$x@3WQ>OH1vSweRma#dSFx#d-%@xXOR9L-@47W8WW|17*ar(4KF+ zL3TH0XmpUB0`%wk;**Q3dWHE)gY2;~@+U*=>Ci<&91aAC%0g}bY0v%Ta4=Rt3tQr& z|JuTKG*AXuHUSC22B(2Ct)<;n2P% z@>ce2`cgg57LpO5Yn|8&X0K>ovC=KijJ8F6m>q4q`=1A3w-8P`+Aie#wAOy?HB{vl z*aE5AqidS1BfMQ(+Y@PEeQWz2VR*L1+AnZ?Zp9ojVxpM?G^}r9k7YXo>a;6mOF)x1 zi{k95d{bwU>yJ*dr_-lG zrvqC|J2CnuvI)u#NI$F9G1ERCEz(#J$&K^qquL$>`1B zdpkwHnjwAUH<_PHXy&w+m8-V2w_SP@qw<0+0Ni)7z5S!WUZ5so$6kgpH!4M=i8d*= zHm#)Ss;^D4HPN*oWKUfY&Ti^X_A>2yi>_=SiSORRIdi)@*-O~3pqb6Euu#q*>1-zl z9QUpTY__W-omr{nDxnLduT&Kq5uMTzC^R=M;D`6b0KmGii(W%XUG-Ru?rOWHwE?Pb z36}l*uD1A+=XRq=e3SLXx3!x+Fo>Nko*wofU7T>XxbQAzD^6y61n-$W?DlkbX%BlY z(IxdNOii_g954c7xcG;8N2)y%_c|-hE+%n9nmt`REeMHiE{t}+z&5mik|qu3Cs_j2 z)c8wwzwBCY0ZYA$y0E7`j9uMxxP;FEpafwKQ@Q^mSaeNK)=U-gVq`$h;S3hEp59*I zS*0%O#bmBicl4s?;5+z|l5uF-D|^w84yvw~{XM7Q9=OoHlU*1ZvS$7hEV5c{`=@;! zrsnRw^`vUdaeHrDm}ik{RbfvU*Q$X+sQTD@{DiM;Br<)}MfM4e1ezoBvU{2HZWr5` zS||vxePRNa{u4pzVy5{UwT(;22ghM1XP(P(k5PSXk?+&`+Sf%2VnOoJ3u>-Po6L5i z&3);Gejx?QO3PQj_OqV}FJOFn@z_@7gG${O@6{g%*(X~#fI99~6$9*) zv$UJ49ThUr&e7jfq^@QjQ3C8i&64J;tpn|y;rIEMI>Fh}?MY|REk|b9$+{jXtI2xI zp!zO9H8cb^eaf)7ZX22p$v@6YE6uPw;lxc-*-n{Z$DXCVo=a?zkqNO8qn2F)xp9@| z;iqeAq7flu^$mqN8uMr-Z+uiF zv*U)S${fKMmFt(jPe$3Z{L^LlaxP=Y$d&gmmRZf^c9eGF(Zk>$cYFmh!2zp@OK86t zH0TF*rEyw$=_6vL&4Qs?s5u6$`ngzTT#Zy;ngw2eAizj$%d#=jNCnB#8j%8@`WNs; ze5@+*jQE#^i(}NUqoM@ZI>B%=RV+Vpq=1#?%EcFE#l*|R} z=$btS6oxARrxy82$H4xuV*s_4qZWmb#XHVUr}o@&n$QSTH-k6I_QPBB74}VTlZB@$ zyTWd+36$2IR!&r3!K}ihUuiqhi~JKRm{~w~wVHON28E(4H8$NUmxsjBLP_}&X>G-L zyHEI_qpmQMrVfnPaH&u1?Q@kqm~0$250Y$WLH@O7g|&)hA*%>vcXkkcqZV zg8zgzs`!|*puhe(_QUk5Y)5==wg2h(_Nr4Ziwpx_F4T?L$<^SsE!TcrtEWB6)0XXo zrOA-v!hhRKnql!r1dD&ct^_1MVLg}+w2f2jFl|z3Mt^|19xCkzBA2eX3HP_sDYk3h z{3{`^+-AJ^Vd_&($fY;U(R&kg9et(@Ru8-l2YPb)%e+`?JP5twI?P3 zb>l)Wegm_M<>3Z~2fB2FJu6}F*9{HA>JQ~7>q7@U58R6fkF2-68+BWgZqjTaaZ!?0 z`p7ojioN*yEV{{_s*x~WHxcK!8`!`nGm$Pz{A&-Lrhn~a%(RO&qQn<#Mo^6J=u8kh zt0CiNJsa2FtXZ-Qk&CzAY`cC}c!t!qa@6=<7N-UDjR1ze)@I|pXh&G)j9I!-8PSd* zEuE!Tb=fRfP(f3;+-^qPt%*k6_{USo!$)V?qE7)U3koC*WwJ`0AS7?L7O(s>wsp3a z21S8LuB3bPQ~hi$6d(K`JVxDhi(Lt4Cft_x$&%%_jIDVZGBl?Zb{nW-`Dxw8qjH<< zTXdU!$nRUWTCaIoyr-9;{-fMr__44x;BN2|es2F`ywm4u zkR3hO?%FKcp`ca<(vOFW=IU|Nc=Fx3T3iPlQktBWk#iX8pPp~;0t2^kMc@ky^wQRp zFuy?f6jv%<>GI>^Qd{DnUENdQ3O=s6$3N;9-eXIQKEzA(MfceK+K6v+dm1FzPZ$yz zdg4dl%Q|Xwu!B>*U-u%6m%^k=MiFu)GeM>2X(;it{tM@^Ae(CdV&~gSG*0iW4yK`J zubdBbl&a46+0)g__apRF-e*Us*aiMO#<}7?@WdMT@}ztDpLH6W7UZV>=P=7SDsf?+5@!qRri9F zDotU zL@q?_l*>CR`XNk26BpB{J`ceSyr;5A@VxJq@PS*xc2)5ZywDDnv6y;4bT1#t1r6O| z+YG9TR-ae2hTB<8f2&pXV*B3Ek7YPi-BH<)@-Ujz*dm+gIFHy~HMNMT@jhaAQhOTj zq8_nNsoLeF-Tts08@f+_oHoXrQt|-)dMk?HdH1WmMZoF-75xa8&)v%x?xjXwRQ?kB zaq1B}hXaUb>&O!Zt748 z|79+*Q&qa6*_li2!RjtWmck|WD9`t*V2M3URh2+ZB9=*&OIaMpRQD2l0(&}m*+WgF z1h#W<-&I8^hNV_zC@_4TnxlY*pHzh+^Kliq%8}Ir&9!M*fyHhK8dsyyasztO^o4w{i}RL}UQ;TQC3mT% zRF=7lajGiizx-8px(X|Ev!MJe;%)xp@?V(@<>Pja+9Pi(AE$t*CrERl;t98?;T)-2 zT?(T?^V9L^=Ds(&*(6EwmNB)Fs-O&-eV+S%7`V zogJf=KB*}rJOR#H|6_eoID|F4xTZ{Brwu0oV%r z1ALxGKW{(SK?1Ui>Oru3fPS83`^5971rssYmd?Z;fOI0>h{z<#jfb*EDbKb@BfK#X z2t*MwU;cvKNfR6@(IQZQm8tg~d%@NotY?tFu^UnF(fo~?mlO)4`H;@4;1p`X%AUxP z=`WE5+w)6^CjqljqY_E&eaRl=j#lsD%&8%#g??YI57|D{fFJ{^Cx~^ISp}(G^s+s* zdsCVy?n77blcox+ntZ@=ZVaFaPq2wrStJ9|5h_ZQt@&;noBi-a!4Z1?=gl{#*2{?cHMc2<%AtBnVC1 zPe3J`Mnux={~EX_+jrG#l*q?(UblPeSf?UL%3MlQ1*~Oc{;9GomI%LHkvmSTr&}Jro5vCT0b|sx!_%U zHKliWPirAPaVUUhjt#~I@I8i?QH%UQ54kUQyPX_FPm{dZPbM0&GyFpY{ncu;H{S4V z|BzMs7bfmBzChUjiUyyoLMNK7ZmHHnK}9vZD;;ZM2U+y7y+U(Ay;NPeIFIc_eoykP z+zBora6OiKYyr&>9mUmu;s<&5OEktNFYUta!}L!Xe=wYDoZs-N=Jkc)_OFnwgsaCK z7US-u?<|9~G!J<^bGOz_kJ}B##dxyYP6;7O0|=OX9kB#8N#74qgQefEu^CH_+1+o4 z=>Z7XMg&6yumnxm&kPHIwJa{05K~-P5K?jg>bhE8c;KuG#2XH1HPPM!dQo@yT;rtC zpWEL`wcvN{KPFIveZ)$EeUJY>h}@e-sVt5CE~0mbg^YR)0%RQwiVitA|W`a^cNvk0Ae zf;KYy5kIYFP*_-T)CEK&ZQ*!T&d7Esyu#bDTkLDN&kKc0=)v;W6Ho|u@b^OA2PoI+ zIrEdQqHi>`?)b(Y*i4VmQCZ*GuhL6RtV%nvrlSsPlGgvQ7FonHr$zVj2azimeDJGjL!`p#a%*J@Wg!!tzN7U7j-c=RsL-y@=47@_V(LZQnsueJ3pnd>7rl^%a_*YSwD%%I)*!}~0 z97OgX^%U;?5lqOJwV>GnpPrBNRd=SwKeK z5pwgQ7BuL%ebj9sPS@$|&`CdOyEYovs8X$utM*-c(w-a?+KI^`7%O`*!UL)UyrqA! zhv_cj^?zwAd|FQF86ZUS?(ok3+1;(Oe?{-CDV93Or1-Y~YS+p@EVa2jnAknYk1 z82(L$z&{UNZJe=8{@ScrL%RA2zg>gbF2hEsoS}R8*k|R;hz-Ht{R_W=L z>L-2yjf|_NS;<9%#%Ya=>?$g{3DYob5xr|_Yv(TRWjS$au6sGsS~{%IK*0`Np9DUM zaYCB4fi~+HyDlNsx`vt<2bS7b7vppd)-ewRqsc^y#!x1xmr667L=H~QGMr>KQWV)h zeWk+@&KyJ|N$hI~B&kl8L+nYz31dG%z2WpAtZCy*-1sR;2Q-fD(4VGsqI3^G`I8n2 zv5~8Qf`In`Rb~PUKV#f>Qgo09K{bK51C^&IHqt5&bR=C>q~e{C4?@edoZ)=3+;Wl= zGN?ofy2O7Sff_oYXLe#R5U%%d(wLn04b7adr$gLp&Baf@1aU}24mR`Bo33r zLCwP54_60mz~E<&9dS}TBh=Ol;$uqU0nlBJV-la!|7?bir0z%#un8q_{5ot&qvD-> z>0-RoTZ}g?5}b}a79 zI^C${;DwG;obwp;gE7JF&tb@oubJgNCAUE__|#Uar(L zNmUYngj!bipV7&V0Y6gRj$B8R8D{^z*@gH5t}J2aMrYgdyxJX4xI;huH6esR!h@`R68lc%Z8o~8w!F6!V6 z#Iq%vn)7v-S{l}fG31gNLfi; zS$C_|j;<7WOVc6?2BLEq^oTq>VO1tsj;PdsgQhze;Ez)^P zVUl|kS9Zs_@qAXeZe22-B29*-;A+IX^d8Q5-Y)OqT;A+Ni@O?|6P@aGZT4zT(^tf~ zOLc}f>)zc&4%MJ{EY<1J?9JRj2LKWYP#Vlm~OPD)Pb2um(hMj-J)%8=_K{}r32yBfloDNHO)Mm;w}!dv%(l0EFt462!Hzx6?;u_6CP9Q5n6R7%W)&QsQ2e zds*gQmg`ICqcn`u3iib$`u6vB#s)WTg$k_Y(?KCRJmw#eZgfZ#1LF4~B;hPsSNOBa z>p)gv&d!o`r9Ug9)|geM?5|lptCXjoGa>qMzG#LDRP?5EnTmc8Htf0m0U;eC9h2qp zm@w`~_jm3^!77nWG`EAhJ z=fBK?Roee1N5Q3kjN-m#2)u(F%i{FaRZ|mHryBWiUPb~9|7~ymke?J{ubJ0jA^(`WzfT?HglAK-4Yh;TvhQApVVIF$e!-*mxGgq6H8Ea zmwKGy)E>l0x*XJmJK5zBEViXz?)ZoU?_2mU2M^8FDr>AWUGMJ__W?fCvjZ#h;aKNZ zMiV6^((s)Gd(0UJ{_8Bw&~r-8V1MqWX>9(`C5Q(DgzT(>E=7c?t=nQ9)#*xS3Y9!` zrPEXDx{@(*^}|}v8mNaN{bjPPS`4Cd#yfqvY+{qO9yQGG*NZ3nlLQ|*F`j`SNZwV> zApLHJD*KR_7CDbt5xzB7fe?t6zTs-;u~6BhhL@rK1`#(HR*kk`dgf$kgdeaf_&Y=e&?enE?r&+kqcv8;>z! zbiPPcF&Q`2!gg`7CE3mz788d+a#&wB)DbJ_9Vj05WIM5EQ#|Zp|3qn<4s64?#+j%! zRwEGnz?p^D=#N)k;|vU1-C8YvKRC{6sw5GFxyHZf>Q&?{Vu&AYz zfRZP1ivUX!5H$z#Mu<}<7NI!@;-!_*XF7%cRT;f0*O}yRowh2b{@alaGY|dSDQ3c` zs4s`eW>0p8Xp5lCPwqa=0zZAZQd*IBzL^oT% zs4WQKS|>kpt-qUES}s1=gPls(IunD=QqJh94##PN6i29{Z=;-IZy(B;>MRR=iXx_} zgAZ{$$HZyO5E$@!r>Aagl*+5-xU6r9{*rmUBkH(<>zxTWEgrZYMo&~ntyIOu9B4mk zx-&&$!B^bi+@?WrI>B$wLDqQ#4dJL8!K(=1H-bd#Rn|?;u%M?~tD7Hi&Q}s!z_43r?{-V7Q=O(thkEh=i$M-|@exEtby`+);|$&1&|EGJcsUF4W*{48e=vzIoT z<=J$rXZ~zGs|RKyEE8k*7H4<(2LIT1RQ+#teh+%KwK~57$F0oUpy;c8*WTuEE(dWS zuY!3?eUHcqRlTB#K6|_KN0482q0PWigTn}Otgs-&-{nlD?D=;&4+h5(M(6Twt&>zv zH%{yMoBzT%+99i3YgW2HQ$*-+`gB9{#M7S>H|Y*`qh{7caCpq!h(*G^&1Edts)D)B zbwTCypml6J#NNn!fF-m6w^dBVp)nX8tG~j7l>J??(G_%?f7%iuWDQ9m-aEO>wlqnW`-{+U~Co?nXE+ zy(=cfcl$k#H%P;39~~ZDE5}jpks&;w6V1skQN-LwlCIFj^;>c9WDwEYF(@AR{btdc0MRD?qt$X1yC675X zG)15@I(I;F*rW;`Be&2zzdA953cX!9TTk3&!}z&{Car+=W#80KgVR#;L>LSlAI?@6E_SXQHN^^xT9vQb?%LPRba|L8lbwh)J;J4r?_lZTc1MA z!>?wYa4Yf-UG=_JVZNE`oLbT8<*wIguWY@h6G_h^qm>?I?-ppUm!9WfRdAFrHT^cA zCpoFMK1=;eHUO|&)Yc7}ZD@LW9^X%(&^gZnvpVw&p4Y_g!V-DT5f9=G&pGetVlPoe z7jST7VY#z_Wcu7gWmdONRW%%bSMm@TEx*DUt{HyOhX#7*GWSBp^oJOqbvf8Ob7Z9U_YE`d+fvF8~RohwFl zdI9|Dp7^Vq5ALePOj&b?gPgX%0I9{VC2}Lv_@-LPMNNE#rP}KyXNhN<@4c6tV2}3P zqUc7711WsjiP6a-kOc@)lVmabpCwr!`7FtTHO`VOJVx_mJ*YCEjma#q9>oR2o#NW9 zL`!*@b)TcMHo?TCZ$b#s_p;}UBqmIf-d1J2#!n|O@Sb;1-x3zqKOH#i=(*2)1-;q_ zjB_VymClMpyItMzisMA@I3xK(wfq%lOwdQI)emigZBLaddW~aUy|1#mSmM>2f#y)} z?F|jTtIn@EgMzI8svBQ(+IgydJO zLxb22M4S#}A4*!&=K;!7=_E$~id%2fWV%<$vdvWml}=2T4%8P$Ap`scN#ULOLdG_m z-#z>UkALj%&raQ+=oV)b`h)Upb)4L(OD-7fnDDTm$w@l&U>$+;hB#b z8hY+*Xpn&oH1*_x=1qT>XK8wjN@HEm9mHePo~H5KbYxodEWCg)MDo`(Z^QoP-wx-w z>9?)Uc&^^p94OcBYdF7I<=JFtT0lC_O)KoEvfpzCMc04QJR7Hqz2_t*wV~&lwMEcP zrKw5$q^BADBz>W(drvb7;qN<%olku1j)SnVfwB6=pC*JckhaU0^*+L|Jq&WyrmA+(DfgF*as#xp<>#Kr<>b3}5kX`L4yg*J?i}aGF#_e<_bCJ#3YWq$g z%iXl(o4HHqX_~L%6Z99@Wv$&X73@6z71kqaX1fqekgIe+Vmrx12*aqKRmE;+Iz=LG z!;$TQQk_&8dvv=B_BegDD@}kY6s-IS1FuH{u))7PnXcFFfejXxbGRy)g)+gr7XdO` zb=a%c>@;H9I{7H`FEw4rp%OB{(t}Q(T>!d-1 z@L|5MzjcCzXFYNR4&Fa5@!!!1_MK=Ca9`GUF7W40M=V_SJp=x!TK7Gm$Pqf1 zLynSTx4PpfPuXh6QP`MWDs4}^=)wHn-QABl56TC}gw`{Abbsb4{x{h1w&~fZ#MAGpb!zZw^4(1<;Lw0H9??7wO>n9WedSgkV z>UNxo^>+ryM@QM7P#T%X1z1$>aSe7N!>KjL(W+@-NELmCgGc$1#ISGye|IfMp3t+@ z;e?ZD$!y5X%WTNRh%VC2m3;yon-p@9$|#OEBIT{9LFMf(Rn5oLS|^v!RP;$edY>zD zWO7`I$~lSlA=@>**M5%$Y{f|@B6L4xWT>K5($SO7dUSj@{LF_O9P~5%V)@U^PnwVW z?*%ZooPtNzYk3mTyx~`@wDj^f7!hd{dv)Il<&fUr^x-UJziIj6z;9aboAkSGTgLCm zdaRt^HGcW^cWT1>?GNY53;%)*nqY?jNd6^{s`vv{+F&)L-no*NtgP3SXpyF>o{2f& za%6LKo5Cc>h}6Qct{SbDN;5jk)oOGWZ3a_@3I! zH_*J+>Y!oAkogndFsez%QGLe;#jhZ#yM#>se;E57_?qhf|IXdL+^fy*-2Jt4?m5TC zu*qgL|81-gvPB_ei$chjib5t8g=~$zRMZwlMQxFzOl{?p6xlxMgQB)jDzu5hEWhXL zea@X(`aXVpIL>{)&-=X3`_Jp&`}KakU#|-OZIS34Kbd{+T=bK9q|)uE6JN2*tY2)h zm`0>yyF48)F8l#_nBkDa@%u3c+GS-`odG!Qb;#_|p=~pHKM?bLGkJml0?6G8nvvWZ zx(s($SnJJcE*CcPM4cZGt(Ddv)U_}cry$ataw1c0vo8O^z*F*V-1c z$HDW|5@$>7z=n5pgvIU(9pcu65VzPyxS19%18W+0BWgK7kKBk|`~&pjjdG;z0Q6%g z?5(NdM#Qr@K-I{@t^P)NhtQ4iJ{7|mOUB%sRNCh+18|MZ05o0tfsJuYpO8H$`#(@e z7M8>KnnTJ_;V}HFX(_X>AQ;|;xqNjrHhYEAK2T`%|z)a&zD5Wx5=UhJK?14bZ|i@?s%LFjHb+^$8v4DIiK7 zB7D5EoP6!08BucVbss@l6eX*IzD>5?GRf&tym9?(mAXfxMS(OdT3&}n*G2k|W#$WSZKvdRV(fq%zei1^pC z3){=nfHkMviwXidh?_7#OYVR#V46E%EPpmxiU>*To`o1JWxZiUFm!C7zfsje&S1rP zN~~;L*Zl0HX@FFElPrr8e{3qxis6F2qmROR%z}9i9gMVH$t)niPAH#MF8|+A{h^pkA|8p@I7>x4|Dq=<}?g>;zVT=_M}OG$EtpCNZI~oAfOoYSni1omkZ6!AUOYLce?yv?Z(szfZ#F= zDBKUMEPVaImSz$dD~>fK0V@M2J4qfP+&?liWFX>xumr*N@VhO!z5T=p#v$p0vp}9c z(>^HFD(P;R7n%IC5Y}RAciG*F+tK(%>~H~5+R%mWa&NQmVKlUdthH!m0fxtu-}kL{ z1%0p|nl-Sw-4$%*htTF8VDX_;UCVm47dcSC{VnYUJ<**o3hD_C6K)laXas<1Jpqxe zuYC!=IyQv*=VzrsYT_74k^k(BEIN~4RqoEO*ad^eUZ5PMG`JU}ky5&^7dS#G<@J(( z?!n@^PZ(}kgdmT}1`ihh3383RYlLJ2t`NrBz%By%$@{Ofm&`GF3X(xC6$(hkXQAj# z#+233VDmQBygi#NSX{YzyO=C*0DUb=k!K};zdRZbPO{w_1nPuwjSV=&oU zKS?Qp5s~O9LXN=8?J$`atJTBg$p4QO4<<8=F4wTl(CrXCFa>vE(U)_(9F5;1$V}<& zg7t~~s@uhYBA*uxA}fBl7=KZ8+;FfzxS$#?o5oI)MB^5&k;05~!)3co%nc4={0L=r z&Q9LLyhHBV)Dyc%x1hWQOx*8~t9Wf~MvZ!UguIyHZX{+O%8ii#<^wciBu41~EjLpi z@Xa)tY0D7q6FeG2_%+bXjy-$>a3@4;D7o&${0IeDB(1#Dl8C#TCz}r4DJ0?AJ7tfs z{JCEB|3DyKiD7%w45v|cml(myyTpP;8U^{rT74}WC7uYo_~KDwQ2#T^l3lvzmrsFZ z9+uTYKKsXKDSNaWBaDkw3^}7OgCgq}1qxHiXmfouTHuZNMEfzaDN3?#p$*k;!yaMA z7%|l|#$0XHg)vuK6+aF!WwpD-DD}BpUVxVGyjzU7SUwj1;I!|H`IZ?pD{i_!Gg%wr zWB;jYpu_hAlcC?8446+PWikkm7#r}m$smN76b=|MeX^Vi!c;OD@+X&`3Symr2;{&# zxL{4gHgMHcIS$8D10Fz@Mx7oIiz=*>e9o0i-hwSx?gOAIaPD^qtCqbFfTEjPvw~>= zF`;=C@;Yzpo5wf^$2j05eVRNDk55k%NF+2nS<_9RoQ{!z4Z?JJGI}VqbMZ3(2Bnla zL;e_9`h#e2JNPn@2U_1Uqfk^lD6?gx`NmB2Q>gMH8{&S8#=x!5M~J(~u)uPK2?tFM zuLM)ta42sJ`@jQL8!+({TIhxZm6q(Z7i7uH_#49EXO?JhNtXPzBT5uYe-&<$i=Ts{ zurM1+lxUL;xgSF75!Cx30XevNXxT%u88omN1-`M9C;Bn}y~GAItpm`B}26`1ES2c#+A+UAQ1r3dyh?44$xbO`yDo#n*6y zcIP*oPSLu;=&a&lc^)1Pdju<4Q4JLhQ90JgvyTArg~QMMYg}{kh@uybuq*FTz}C-nIMNI(Wpkx~-!Jj=&&O=FFEhL0Fhvu-F@mk!4V=Gv1#sAGC?n zFuY&Dbc^#R8f$Z84~uUlPs+0}v~3q*%^OE~iy&UWBk3ZHa3}sMoLCtbpOU{rpcT~3 zAjfdQRix61XXIn9n|xoQ%Ej^sSLen_tP>`Nzyre)d88}8;la)&@|PhV$WRh$;Rao$ zuWO%`6N3^^l7YjC%j`q-v+`0_e9l-Zj|k}Es|bMEg{0FeR(T0fFP;ie-1)h=cJP|| zr63aM#*F2_ATy$vQMMdZ$CV7y-yHSov~V6GjINNg7&%wSTTo1#z-8CkjfYMQIL+KcZDy2ts(Zz z3-UqKv?^aTspNZrk@yxAFzy#x*b7#Ia>h}omCz$45IWGA4y}Zu_8_IN!d!Tal2tOS zq98t8-!oT_eR3~KUM*`uU9I6`6^%K3*{iXl!>c=Ag3#!pi!T9--~{1ieCnXF?`64j zGn{&>FT%_x8GT*@9N_3#aGD;a@^a5TB_a~muZ*UK=&Og4}c$aiUj++1?- zpxUVDMvhzEHxMI`+}c?Xg|%<*jdBgX+v!d8S%f--Y{B7w(pE(@qwgoQ?s*-&-S;N+ zp>+l(0~-xcwQLdqsSj78sCW~k3XJ3?x$|{iM7&JHoD`63SR04<b=r=e0EV|?fUT&ZSy;VM&35Lh)a`@o z_Ue%jspAIo1df(=C{=tS!)n#&@hRv#-b&xab86)6l4E&+vvaqQv=8qV zNR|CL*mxZs{v5->W?}+ceV|McdmyNQ=I@aw3i{0^fl;{NHg&V?3D^Ou!f?-7IGm+n zfpKyVdd$?uPDMST5sCi-z3~`FzhLr*was2R={mp!bQ%?uWMPs|(Ozf3@!iX;P|u!& zHT=j52(~*YyFGrNssJzDLG=}wajZfsp>OwrAHUrIex$d+EMz45IbFWzZd!PA5JIS; z3^s})*$L}^<)H!HeWQx}p{5sxdH=;ndLW!Fw2vM-{9mDDuI>h1RYfa5ctiMFKHzIl z+yU9`;L&JKwc7*3Y&|{n_q}>3WgURpq8DvG0BG+`zZ}3yst;v<13}+o{PGPbj95J| zF(+yhalq#i$BvP9J!wZQ_MLJ?t1Ew+}>Jfr+)?`-uT0EA;ikc!?H)= zeHA{1!*qW%E|xHuX|e7JJ4WBi9x$VjZ{<(9hu=aUZ5a$8Bni&oeg`-@Xha;5NAcXj zeF8Hp;OtVVpV8+B`9>S?Y;ZLYEQ8*!mVXz1&vB%EhX+1Dev~iRQTqL#L0AqNMJKs* zva$JB8KDTUEA*RKMk=SEa6V|1pThWnIo6-XQ>-!10C4MR%o&W6AdR2;sABR(Ih^+X zF7HJKh+${?yhhIXcY-*tRxU=vt$+t9XTdP9o?&0Ow`It`QN{YR04xtJ`~!@w&ZzxE z9%~0F8g@bcT8cA3k^H2PhKewfS2=2rOIPVy?j<1aLF!N^2oY=yA`8~SU1@Hee8KV% zUmMsK&=~_gcJXCsj1JN-m*qNv%@cgsyi!WBq>)lYv)tP=ECUk;MfXHHa(kFexn1E? zf7}T8nspC{W4GcfAlZM?&MTmh{a2+csx*NAZ;=Y zWB^of$=%#`p?+k9=JJCnK~g#kJZB)~tlP{iR@C`Q4f$u*P?05ctvApNy8^#i_5N@Z zHPvHR7*Du1AC_`e{KvK5PDOu!^<;e+4S(710LzMPioKif4aRNXSTnKmiC8|0(YU7J zBs8ZL3!r&+`zb6Fbn;WeBuMoBZqGGJ)->uD5Ku*k_`vX2Heh@g~yKaQfrH&@(2+?9~VWhlM5lGMSM&4MJR*OY{;>Nt<5 zSnx(FX|BLMh(+pK^C5ODJew;+g}}>SZ+M;hIF*=ozM301ii`O~R_@L{9(ukA>T~Tc zoS53^RF+5+D8Z$ug3~a-F!|$x8IGFvJmAi}=iQh6I^*3ldl&0mOC;kGtV z8ReRc2C=AMr@W5#Fyw}~0fY?0z72Vvj43qUt#lSPP&~QJ0Vm=z!KBEo#I&7ijRt4& z2{-=ZsbnpY6Bp+rl7d@V1g?=Cq$Gm&y&j~j!-@F8t(1wvz5zw9@%`yIsC^@9|*7r;{G6M4{*{!FU7P&B6H4LHZzAiFD0qc%%0F=rB4L ztOTQKSBNs!^Lo5{FUwB}Ccbn2BO7`D6eAeIHL}$s^V=> z3`Qua;@k)io}OPl9V>zeh4-v2H^gs7D6CVii~v%KD4<-9Y7rb~TWh5~b7~=?XIy|) zN!n&e9BGltbcChY8L8}mt=(fX<{rT)ggU=iQ8v<~JC$(C@+!G>62J1ZPP(b)&mey~ z)e~otdaDY{-V0TQH++NcbH^ItngU;85b<wF1J%o z0UwGs!|*XVv6a1`y^>{C8)FHD<#svBC~L34w-}aw9h6T49>KH=NC$2XrOGi_&Q^64 zG(w-?_E>9%qW5q*HU3x7nb9|^V9&7%E6|>e#TX?~K%BA#xAHh8QDF>cL7b6;DG!rd zAEtXKs1u+#iKcc^RtV9&1xedL+v4WI(_-;{fJ*Nk>^ANug>7^O-=wIb)QyzD?o@Mb zQm_g%mfxhz;-dsoyaL0S3`$4<4G=mW9DW`g=FTtff-_VJq6g&(3NP;J6O>rjqgFrP zG!nWfKd>+#)D0k)L_NAG18|$)4LIeYo!x+8SZ#L$Y5_nN>tROR&5D!DSMNl4+y`+6 zZD@BTycsg?>#IxXh7S1svWJ2@S#~f{M}ca1xubjM#;eR?i-^_ zvtw9$+@s7jt%vWzQCc{;uHr+DhbAb??AEJ#t4P&YGD+!b6UU~RRWih+(w_U3ScSPI z;}qi;0~6!eRXHVSG6=M_N===NE*|uwrqwN%q^i1nF^>z7hZor`AdpmX;;v2>*L%ukw;P%oD}SxuFMlO10uy; zI0K$B14JGNr?bO(XQA>DP?xe9z+>xo)z#kx51QGNV8Wz5sNlE|)R8llffj7)=Yt~) zj)%aN=U7-;Cud=9chH+zN-W^=n=C~Y`yM6u)l-0<=PB=Lh}g`$eXF1qq*p=i zEnd*f?YhN!6P_+nOv)9H3gR99)cqL%SDsPy4CY+wN<~W`<<<;_hBxOA$r-@dmwNTx z#UOuHnJgO?#&JtP3s7g{{3YOLjk9`PlL9C{3$eX%0etUi=u@UY3jnw#-za-lc}g?yu3nu#W{(-T5sj^J6)fyjTeYtq@Fin0ZS`0~JW??+>p*>ugS=cm>M9Nq%)MM5CAReXzG< zw#fYCc=pGQ@4QS$^OQ)(8iqs442Olsob?Fc7#@fC5AiR661~DUGw9zA4EAb%H2nn# zr-i)C3M2PMhuu~Lv!NA^P@{LgQfPzki=(TQpA}w0GTj=8i&t%JarxombpTjqEstNUSYpmWEbH*zUH68M!4a+G0Z9vtGQB%Hy$%5xzxCUEUV1 z)~Md1{Lmbw%696tm0*FRgio$sO=1wIEH^_Y~$nhh>qtQmqN6I*sOoo+< zF`Zhj@CJnbiISvqQ<}08bf{qqxsD$DMCm2yXHQE1pS!b*srH)~C8&ehslZz>OYErj zq~xC1P#N^8#Zh1g_NmfYycQ{b;(JFw6;KwmOPSTGu?~s{@NLxcg0~IDf9$mzrMnb+ zbJr$(LohdE&zC?@*XD+Fz&=0=cfbnn-PPFil{o+<^-&(`UZIp(EIpI8FYZcZ9>#Ea zB~(r#KZ^3&vJJrh82yc)gUT_x>mAgNp}1ix_F$zb(vE<_y-T+oQQnn`jq^v8Fu#xz z6d8#kHN57=AGiBGrov;TEmVF=nPJKxHC4(`glQ|UhFa_Rj|!B*)xgMYB11CF+jjHz zfqDCotpl;J`Vj!R!$aObgIiPK0r(m^@}t6g{rt4xn38JSY1;G&lh==E#xW(<_OXXv z(F45{kN5||8nukdk14YQcwU)oa3jkp^A|KG>o^$sC;WIaxlaHZKc&2%lwLU60q~r1 z0*%~7l|O+5)I0zq;ljObpj2^`x-U# ztELIDhsaX(mX{3#SUL^Dodad()Z;cEeEc1m~IaWVmY%t?ci zG;I{HBzF&Z<=)fE6x+9!^=jG~Wr^)OOy!}_)^zTSvgw+p9HGs>D@nGargdpS4Zid} zD_+Oq7zS?r=unLkuUDZ@44%v+7)Ps-#y=sMFckdQNUfVzi#m>(8EM6c)?Qo-TsY3w zo3m{vJk+-!upQ-`RicHc$#BF{L>F9K(@zxihY~|oXYtO@{CkLW($qfZ`~d;r7ydmh z;nybZ`3-5_P~lpdswBDAQ`G02GT@qypEhePJ_kN~2B*ZJm;Aj+tu>^dS7L0nkOJ-r zYfbJCaq3{oc_q2qS*sumUOXIsSZUUPar&H<4zbebIZX+dTZUcJgg;68Q+YS&FRQd~ za4%5#pCH(;A^QfZ{?pG>00pY;qBVoiriR-tSq8Y{{!+ASssyk4Ls1J}2o0r={!*TY zsW_*}eE=sBbKk(0#^oJha(;3TI~7KI-2&O`0cfi9H!ZxV#N-#=1(S>3m^Aq!h}0GF z=mtt?=7mCuZ;`a-BGAbO6(@e@exqV~_czxhSc3CIZ9xFs<_z#}PidE+AK6|9#GQj* z1(%gzs+tB{^7WUn$Y@5=WdOH8&r_E`hnhFaaMvLNj^i3iY&?uDmG~$>yW~QQB`#QH%f-Pxp$tuU_pQ#f#$`yzHHvsn76g& z?G^L(s(CA<>>ItYEgRF_qF_4nW%NzgIJ_en!lGlPh!;iN$Y8$ zzqd2ocwy=WguH=9jzs5uK(_(u0IFUc7};l|^~hyG@0(VdB}N{vx2!ZTOL&pVES^^~ zjA(CDW&mp6WEJt%z8Pt_*+%U>-mxC}YJb;C`)V(?(p)<;P5uJcT*A$_Y{qjQMab~@ zmR=5Hj@|&iWx$>L7OWeyT6%+fY-#e1txdl1exq-2>wR+nHj)DIjhfXs)_SC+HySJz z8Hu#o?QJi%;atq88CG=K>GonLC>(A0kn+NTA3LZd+?xoNDpET+1xLVcZyY&W;q}5b zkVZeI>_Fs--(}|S;?qz)pL2V=Bc@QNAWYCF2(IiM2nH%ryEvuNP;8dNBND#$AIffp z&wOUycAK})&D$PPWr4@*1Yb<>pevfk>jpQ(?-9%ceOYuo*gM4>H32N`gT2A*o+Q*8 zhVumTL-3|M6l0tf?2SVdIL@aFAzqm(P>`ZS*)R)V5!KV6Ym(q)4WEH}q2V`ey|&n4 zeiUO)+My6{dz{ggLcLKqql>Ra!PADg9W`&?n>U;c423(%&qKX&t}4tS?`AZk^e1sx z%pK-!@2YOd%L7y(LJ>wg5xj_JgpP-!{Z)b9aI#16uX0fH?&25cjrQe%-H3Vo#hk}q z&D3vZ9bH@d>KG}0aUDw<@;3VN5Q#|Cf#X698E4JZA7&j-Mf&PkFMe?yhZ^!O`0}I+ z=35udIxd+hNZwo{P5?2i)tjlm&D0e$bpr*pVHk5ka+o(Uy8QwPY-l7#%Ezs2R@%p{ z{H!!?0>AB6ni**~Tn;PEIL_&2R@#Tb&8@T#gPm5|!eCMrufygFp}y5hYk0o)2D@6I z1kas=%CE3grg-B)xy##OmNt34y#;lI-iOn@Rqq;+4(2r0918=2>9QAOEkqQMLd{#4 zc?%aeD%HKRc&jz1vB-NDgPiLO^mjz!(=ugtma#7!r^4&?&0q{CKZQ`5rg`Tfyh=he zAgoG5ixilyd1G-bqL1#K0QDEQ2L`>>?J&9m@v$YNBdZM$cq|0_>}dW}pw}%n)tL4% z;flr=(V1W1PBv>lIAFy&{8xBMhl2kvg!8Le9q6yOwT8?$r0uMg%RsU3p?U0xCRjfZs#%LFuLQ>8))kuLQj0@z!C*V>1;h3 zCwhuRD7K71D|&HhSp59b5_T5IXxkefYRtp?G)ed6GzG=M(iqO=WK+heY76St&z#p} zp4UW}b!4`~WcN2S2bh_u=FG;&cxC;TCKcb>Bt4L3#CT)74Qi4-xJml9Cg~xZhUJ0- zeko(TU2W1(Bc!AEXNg7*1aZpg*v#M1;=Jwcw%bGK9mU>`vf_aP!;QRn?{J%xW>k0a z4s^moqIw@dFz0Ky{TtNFJH4572Mkg{yM@tgMT+-=G(uz;RsFpW+v%w+Z+Jlx0v%-y z^kTp7PGip?@3H36U9>q3Q!>gpo#yomlSUi0lf7e`!$teBnck)F&VG2N_ibq`6|Dn) zx|hMqrA)`M+d`YiK|8a&Nzyo~&cp1u7hq-L&h|PT9U+@bRQ@B5a`(>mvX8W*7tyLC z*}$@UDDNS(x&1?!)^?Qs5I#JCvl6k7gtg~7M1zUVC$-bfD8LuQw z;*ZY-`5m?de6<8xQE!;&qzz^)ipQu};@u=k_Zjn_^L{L0GhQ@R+l|eQ(aXHiHffGA z|9LMAStpBuGRkr>ml9ly=6N?bh5{1&C^IZHQml5T3RE%5Uhu9oy^OS?+BZU?jCm`) zP^Ggt(wegG!|6BeFmR#jwh#GX2&(7p2gpJDU-l5o@=INxph0#u9&FkJn67BsEm6gqe z|Mb#HkkSh`fE?h%8@vPjXmu%`6%WBmB=~I%<`AR&ZSPnonx|~_E_KbqXN3NSO164m z4tUs?guvK>vJYZIs^$x?mhax?Utoh=|jwU3C;h|I~-enz%)oN3Eb{W zdNaee!&@L>_bq6W8c9I?7wB!5nkHcRgJ==JgLq#smIixLio}`@Mu&Tvg%Sf*z*- zi0y&2!JrEnmEKZcM*M%hd$HM6|6h#zBAz$3;5e29r@r<+g;%o=fJT)d{+D;153kaD zBEZ`8|KTlxXpyw=L(nw&gB#%*`;hmzbs@j_&J!1^}5jc#-l^+8E zUQ8E{VF^(}DaXA7q$Qk+GzyPcCE7V3OKKyi>%~ov&gvf zDDt9}_mZ*jymyEn_D2MHsk-33jOf1LDPyIz)Z>zOk?R$!qGKy&kUt9yILW=Zsa-Ce97?!3gK+_WCM$~PS-}1Fv(YC zpbDC6WV+SgnJuJy)FeCHMn4;-_ChpV%v%ywtam#NdpKGmy=@{_d>)lv!3aK-nkBGoE{#KnZ=L)$Evb=qezuSwp5zUC+@NPn?elEn+EXy3v=zh*x4 z?3y}<0ZCK0V8kBL)rla=hjsNv9>5cA)R(d7249V`h*n;Tf0$7grJj;pTdua|ZBW6A zwrUM4tJ|qtT<>3f6sU#;@Z4|nWf?^=T)9D;+pDpT?Z{4{B0qSRscEnFmOh|P9n=Na z-AiC?DED0D= zyxW8nttQNAxNlZR+TjgVNOKTU@PR8}XYuLKMdbFxAnY+8iH()`UVuG1cem=M!iS(5 z82tr141zBN3h$#n6~sQ!eS6mY8yde~AP(;BqizS)eY&rTh*58i01ksMBo#*V3vC}XBkWbQ8g2qJ%xO>ypjo0wPGAuP!+^t4SmB#tI)e($_gU8|iUy~ZZAuR~+ICZq+ zYfLdL^LxSErm#Qk&Nn><$9Bo%)z!8GA>@5AvNdIeLMb@?7Tvk+9+e5A0WoNzM5!|Y zgF=)p&QQUvd^Ubls4@yWGg;jc9W?h_$YN>FLG$CjAFfqv_GxzGg8SSxE5#Xh$l^ zRy}CJ^5tP_!E>_HIF*gTfjLmXEER0ZSUyXgYqO}!!XIp51%=K1jrd2^3>yX^Z;l#c z`{yYqApxgn!ijoKKY#3uAAldij1jOB@}H~D6E4yH*_a0qg#j}*%~gl`p|XolfY{@U zn{(7FHkKh5K}acE1Q;oy+C>29j)d>2#>S`A90?q;!!zo4Qk5yu%8S+B5!^ri^J!A6 z0g8--^_0C>-2hD-Xb8^0EK!56E^vS{OVD3MW-RL;1(LOo)4ov<3> zrRtTcs{e!}W7p5P^K`Lr$?20;{x62U3f*=6+VEO=fvUQGYn((pn*uPVQ}8CQ`biy5 zTd$t6?!R028tYzb-On2LtyYt4(%r_|m(F%^NDL7Yu!a8p{!Kg(Og8xyu6Tzlj0= z%ghxzfsFPn5tK*Ujp8@e%Mz51jLWWzXfuDR&ZvA_9mp|hB8t^50hfH)0?NvN1TQ&N ztPXY6S@{q+OVokZS~GpT4W|`L)RnHw)?+V1SF0p8?r(sFoP*8tGQWhF1n;KsthNR6 zNsIX=?to@sr zzx_YQ@8(wiXLguM*FoH!zD=D3Sr?@vu@80iC4^Gv3dBnYr7kMtm(uv0OvYh{zcJcS z;e!m}qqhUhnY5yTU%<35_w{B@C?7NTqejFH+y{}VYP)&_C3k)Rs@#(F57jVRU?_bx zA><~?xZ7?Q`*nyl@*&<>XDt6vU2G2u3cdDR!a7R$RE?#ykJU8+t?-Nylc#c>aq(lk z7Ua2J`9w;tLLbMKtMdYa8^1(&sn-VW6IBWdx!#MrLqZ!D=g#3^YNDC)(3Cx@ zzbg{e@WOW*6-hynw0e&^8d}@hJt(bE!WS4ZZz%QMg<;G1LJbxcZ=y+f1rAYByycI7!BSHMjxZ5NH|m0^P0vyW)L-qT_f@d+|$Z zE9Q=-RH)JU@%$&^Y?i7t* z`5D-&LEsJkaBc$c-&d%~wAJ^dQ=xAu1+`=~J6=|oMv zE7frbY%0Jj(X0ottg!hT?=&t~s<}2;(=9&$<_HIp?}WotV|+`^)(tqdEwH2Q=1_WN ze9JbpX(o233cmr>c+DvPMjeY2n;3sV8Yra>sGBnaD4P2NxF>uHI4R?p4Wfbp4MEoT zstiscE!DzSO^NW|Q2af%kg;n1K^<#zb#JI7prGNJ9?rhTuIyvrCecan2lT>1T(kzM_mv>-)8HMBO08h98;HpjyjI3&_I+Jl|QK) zY_?ujrMcZ<(OmcoM8)1T<5z%*XcQ!dU)41H)_;RwVCf9Br%_|pZz{VTeDODR%Qc4P zHv@wD(D+koq@yp|TNq15rL`D_p^Ig9MvTGY4kEb1Hdhp#^EEMA)ahw3j7Y%C2vtM=2!p$Dul zXNi;P>i8zJm|5bMwf3`~y%mrCnCfT`x10itE*_BItJzRZenwP~ZH&K`AEs(^r#Rp-682 z8?yEg+V?j&GAo@zeC6~jSUPeJLd2MFX8Ur2eL3Yt23{762GvGJ1kJ^49R{z-wq=nGH&0}QNDdg0dCxmh$4=o;#)=ULu&V+Lr`t72$23W|Z<6lNB;Bz|I<`@II_mF%iw9@7-wiY~M0>;)hXP`>XkVzN zVn^?Eh!*C$sUf#hD3YD8Cc~~4O1PTKg}O8(mp3ZZwINs3)U6?Tx>2E|hFnpodqZ+q z_|?z#Y{(UbdNm|Pi+f+2?9-4Gh5I%nMd5zeCX*YIGs3kmT`9h#krJWdn73stzOuEJ z;p&fPtknOJ>RW3uV$lFYBs-3TBC;BM>2-zSYovD4W*ZPj-+u;&nf_C7G-8}rbNV?_ z@ou09w{7I;+D0kj7VAT7sE+OV26Zkx^^9oEVN%CLX)N^?MQLF|*W6Nw?^F?`ZFMyS ztD{T>4iF2YwPjEfbZV=4Bu@*3@l)nc(+%KR^w|!cj|kcP)m}DqL1;V0@mW* z-xQQ>Mzu$Euo<&btF;B)wKRB+Nbj!AG%J{B-a6CeJ=lmZ_A=D;@YSA3r@Y{!$iM;r z9+<+RJS^y1Pt7Tqj2{(EhftE$6I7j9o0Z0*APXwE=wB}iJpAngxO9BHtYh|YH#EIKuQuof9K3@@{`g87)x08mOgD`~bt(T53y zxJBiIwIODGu#>qQf!KAo0pd;k6Qin;ej8w^_%_Y$N^ckjA;)KJ#@W62yTS1<hiar7{)w}T}U4dI%w5GzY-Zb!3A(qX?KBNX1PXO{mAWL z!t7a%)ucKVeaNrguFbK=R(~AiW8)}2n2K)&3XB^L4g{(0AuX2T(?C)CQb`(^EeKc| z2DoqjT3}D%jiK!kRTry@v~+E?gPETnRZfiX6x^YW3*e*;-(m{XlcwGQg5A?7xjq{;qxokfSqgZ!vM;-&tzve-V^0T|6E*m;d%-e|8YLEJ_aCGwsD#Pipz|l zgwZ&%n(;=YUC=ToWquOiadA;5Z7wQ$8szlAf$(5x4vWSDwdXz80yKIz16dyk{Nr8* za`9hA2**ThFaxL3T1OMnwM2_`^*?NcbP1mWF#;*kdooai0ow9!h}nhtayU zi!GcAv}WR@Tr}>?Kls!f=dsEUu12P}^w3HtHfVAavDO^gHp1!PQf{j47U@awVHgt( z*445g&Wek!xcqR%;bPgEf8T)6pH52o!VQf30<*Z}B`w^=Uu7xYP38A!k*-lbh+t!d z$bt!4bOaA7f04(Zd*&NxobJ9e5C;S9M?ZWVDbUC_aGQ>_))ii1#)l>q~(vIn%i(BLkgCPbJ$(?DYPQT;T?q~|DQy0#S3>%Qrr zoLy<{43NYz0#1ya2T{LcH}^e1Xfn9d2omP zyXcWQ;Dmy&gH+E!Cw5W&9BnuZ+PDhgeIt2y^YB$UfVa{dXwA~vF%y4G8>uuV3{x;2 zH{;5*>OVk1k82Z@dwofu3xhLb3KtdlOv@jK3~-JPKaNrFPs&`;Us$%qQ1M)i4P0i- z(`F&)7Fxo5P@1nri3OgU5`KU*lssQ!lb(h1wWJVUd@-K!2Yig9zp-z=c7-kA#AxL1 z#yPE;1)4MXFy@b87y;qL9ij5BQ0^jZmuopdru&S99PMifEpt4HG5Uf!Jc$P0kJE-2 z-z86ChN$Ru+<;9NFa6Bwpr1gWLeDxv>=M;XMQ`t|U69Ppj z;X9nWFMdiJr%(0G3dlE8aHixunh*H$Ntn+hKaCE*Mhl-7i-OvxF*qf3-!odGK!Mh9 z)C8SY@iSUHoqQ5T!tTWyTzOUjmk`Mt(%oXs8SxRi%4o!68C*TtNV!HLiFGt0ONUfD}AM?zbg=xf}OrP?OxL8?BBdgHy|`i09N zz|Eu&mI0j_%fmI7z^|7qZxBfVpS8&eV*4A!AuY>d>LC;<5yrD{-ifoXk&$5 zj7P`EFL@%fDI!1Fmmy-E#KIm3e<$x$-Nnedn%R>3{ypmBqL|$5s00l`DVZ`VKTar0&X< zA1+@F75hZJ8LN@mDO-Z0iPUeJ-H|d14|rO64=NsaMhV_rWJ#nQE`FgsE|#tNH}`|@ zfC6#vK($LT5EUJ1(sbk51&X-*@49VQWRf04|}WfOg?s zEzY&bdL}-J<@vi>nd_;>c?d~X47koM1`s~|j|ZzAvytaVdN!Z2E71-KwHl-(H)NQc z_kauVAN3ykj}`EH(C_hb%0`(#!@$$MMO(r_8^0PE*^bJ#V4?razfR|;c>lilg@OmG zb8yLR;B+NM$Tn?&4I?*ZJM;jvDRT!z*1Zy9DwIxul}-F#Eck7N6mhw2h(={YIr7;y zE!fEY06f+#pMQ;)Wk&VIydZ{6j44zr3<4nXr}ZnYuk8${rQ0DG$fw2ZNfFYYLTyvPAw%DM|?C&}Mv zO8|D2QMxC;s*|0nzJZ#jgid^;ZE>x}i;T+k21BJ}dohe|zgurjRRt8gYx}CdgOnz2(B&P0zVbDcPeHeEK=e4qJLkC9?poKljwmWUg4I4NKr~AD z4-6279>ws2svm_s0VF!A4Roz>Yc$S0C>Qq6VM;wM3Xomq&Kom#&?JQTKft32S+^r3FF!l{*D6j^ZF#?C+MvC=qMJxPk?-v z{lv7F0)7^(H|1w7EZ|M_$+tC+SCiO)3@!_W>q(#N#CHL4XoxdEdmPp%`(RpM`m;7P zg5?BW4KsUYFn+6HjP#S*tFE^jl1G0Pgtq#mHrchgAvgUO&48t<>sM_QELE92b}05e zY(nBokk2fMzhsVWLu(VbkG|G&E8hE;I=1-o>HM!)M5G!Czp-dqLXOi~l)lyXv`KC6 z`|@e~&m{KlEjz5ACI(OArzF zaaJU(Cq=9FH)>Tyqr#QkDg<~Ki1mG39cVf1C9(Vxsso_C03Q&HI;bnL`+8aX3xj>} zvNpEu*S?u<0s#ja=TrF_;9U1UP$FgR2eFnTpdl%%*Va${rg1TR$G7nK-@oJ^{FnSg z|B`>$mv8L*8v-q94(O%l=^HI*sx3nJg=9(h$Ik39Nq^gQ#42A8uQB>4$5A9xC}<#5 z{8=_V*!6wm$1vEk=|>>CEcerA$j{8=L9tF|@;)>#FNmLmhCi0-n=cXV|U`(4hrxu6K_(j^`sWSWHD2AWk$? z739>Hx_)X%iki!udUw~)zC1&6>F}#11h-zUlfG=xFeA5xK2M7H1(}Vj|Fv-;!Ixm9 zN!3uOeRBQLV%Q1z>&)+XM~U14dT;c9Sb)x_DIxgte2iSfCSI6OIBQ8i^<0phOmv9$GRlzzR&zC~onS7GQzwSU~=)H`bx2P$@DFT79IuP)*o#h4LDfYr=13n9hvf5w0iU z)+bz_fYz-I*JCBu?+q_iM(AG)xM{%)K=6>Yq2Z+c0MR~vA;?4WF09yUT0`LlKTZZT z!2XfC|25K?NrO8?>cW=q3Pi}!k$UbmY>;IevsitkJ{C2NknvJx(~x%MEjiO>V)rDD!#v`^$>c&#?e~UuSg8++m{L@%mFzS9ovI^YP6) z6EJ|*GD++-ZA{SP`D+Qfwf_@l^zNb$hhgFSrIE~(Y^r!52vphvVX7iOPO9ft;<&E%L zbeww;i6r0iBPpo4>{dMuLlHDkH^rpZRMd|HEf3TowgBWl5?tS@1ijp@%t6lbl6PxG;kW(?AKjmUmrag%NXc>MBFZ$w|evTHv@K(?TXOUbflVzAuO?>uGzRfcAMVI1{=jQ zMtB>Ne}j_0>NY(Ch>|h{vjF!i<@e*8!m(%ZPG~)OJdMlgAhJNW$42Op!eluZ)$j~3?(>jx`3J4K+oK2Krba?`n8BV>ECJhdjq%@?gh2 z1RxwgMo$$~S4i|!o31hhtQwg9$ z*Hv@{n@tWJ$NBxhAW5As!_SUFZ7fMNh-kBhk<4-K{y$DyfkZzJX$(lG?>R?rqF z-=o{n$Xo6K8OM;^qc3vtLV(}XDX5Yy>mK*mh4#-koqQK{;_Ek3p3MpApfwI}y7Mu% zX%lo9)L>r;ysOSg$MP)nA?VIFVH7+Od=G1ai2_F7oCvyLQJ!U!z+hf8 zN+vPMHf?37=01>dh{pG$0)GRI2QL&P3`RMlvFH^hu0yACA!GSe2ovbcz6U@^0ag#_ zNkS71gX-_G?T|c8*Mb5tJq$Cfk>XB3V>3-(YL<>P!l&!-zAIjhq>VH5RD7#;CMGWH zplmM~3Ng~z1)`buAV~OZN_bFkWkCofq53IdM& zFaXD*>jJ>{K8%kG;ttvRVSN%F3hRj}kAM!A(Cd%rhVOCKqoC@RMaY3i_4as-aq}4N z*_cQ4aqS#^=06a?jTZ3WA>QC)7-~_w*vb*dl^zFi0Vq8VC`6;!2x#x)dK~cM;^R8u z3C8O;^D~jg>UjV^v}Nslfw=qTLtwFHKJE#0B7yom0ajt*R#3xtFFpaV!MO77eANO0 zB6<$wk~*qhi0LXTmvLz9CK#YE$u+~v^774L*Ynw*7bTM2Dm2ox4? zFT(A(Opoq4z`sh3r%XALNLW2%8YMgnjSg6}sKxrX@E8;Y@8TVun<`8in=Y3cyl-s$ZeQ z-6OEpLDhk972G=);t(?&%hUV*AF@@4f z^f;7p9L88H0pr-~TBR>`g*8lC(JFnoE4(3jag|;tFrWiTEBv5XA_4K(LWm-m$c@H% zm^TS^n(*Zj&I=-p`qiNAQfp)COZofhUH_9)tzoqzwXViZJf&pRl`og$t`v#BD`aE&I z^mdevqG}hP`8(G>xCy7OZy}{Kxn8{{67Y)(hK@)WdA)w6h?_y2R#+siJ z+V?JiGs?L5F8CKHK|qPV7%v13LXGi$IG??>L_h9|ZkW!Z_pS;~p^h-)zKoa5zr$BtMTzm)e%+7n^DFe3 zHdNt5Z{W|@dNCf9e+}3Qi9wfmS_k6doi3hB^F!8Io1&kaL#Y0S2_yzkXt@uHg(+jD z@%cf0yA;qKmH2oJTr9Es_VtG$=0mUet)3Xr0grtFWE<(nP~YiqF_M`jNk@xf9BJT zc`e#R8e4zXa~Nu{oQyI?pVHGDI4y#aPzlEx{EY*(`X*MSF1!RDO1WtTw(Q1>_W`VM~y5e{3l*}(0%u}x=NT?_i^Hh-KAor3d%S)*WF|9}4~ z{C}Oj30#y_8#nAd%qS?!5Fj8Z!@UeJFbJZc;xdS9xnOGMmJBe;Bn-&nlDK7Vxq;is z)I?3qTmnmPm)uG-vr-=GX?ZmDDJ#o*v^|%4|JQwH0I~1;z2C>r@!bFGT<1Fbew}mF zh?eSLU-6E&&Kkz{`UOa8VTibb*5vO;ikKa%gW8I3>x4u#&?H{b zQHs&1&QZkvLU=OLlt$VeV2*>CEbw7s3hvwy$*XkgQcWO-CmiIqE zJ5$+Hyom!JGi~B{Aw#`v6LIvUm%1}k#6A66S)ibF=U28a?JGtKnM~*>#$(l4Gx~6& zFB$Gj6tnt?!CG~rHC|j2!CK=yP(P6h%bI?ob{}y+k%|~9bc%a5x9&UW=)BSiJMhK* z#RO8rrN+Fbzjy&TJ$HcEN(Y6}Wsivw(CFRyn0VLlDAF{LO&*G^(yKl=6@6l$NNR)E z28vR6FW6CYNKqYyA8NjqJp)}og2CI z3~M{9_95cmUczA2K1`e_K;Pi(aIv2-gn~E;$ukp%fwH(6%Q*E&(Ap=&)jnB(l*mKb z#wWyF>Y_%9MYzCd@<P%s&*Rj2~HfziBEFkC?cZG`x(3SH~V6u zdGo5jQGITd=quppWz}d3PA~T77>Mbm4jqd`MXJsnC-y|5og9bEgxUz&SL}|d8RNw- z4O%Ob#Hzl*4IkYcNHAP)G;RW%U1iHAz|~du!2}WSkub+ZvAuS3ni63EtKErYu9+w< z;-z6E6iBqpAJ20gmq|f=I$z9&R!DcJxB^@sIK}qSv^PrvGV$w-A7L6^P`+rGwS8J7 z1%Q)JBR#gV%TJ3jf}I&Aq3GwZ`IE$SsG6UgB!=n+`!N6eIEa>gKP}sppEG7 z6`+8;%swbYoq3tvE);`&t|GTl{V<0}rqeklmzWQ$#V+LT%dn#6mAXtS6BLH4?4(Of z@yT;%n1kJSiFbtwyhAn?i(v>?T(P*zXQG=UpIt6SdOO*kGO<0&n~cH(<%kmTjFz~* zY-kqsXQ|j$?q4ci5+*UFOicGFaJw!f*HLQ+wL+yULuGQ2n1#?V2%G|E1IxuzP#VDZ zJT3LLjcryNjt%*mDdL-W2B&Z;ie8Dje=16qP|Cumi(?FBkR7q67E5cz!=Qk(db*e; zl&jaLgGDzbjQJ-jB0AB+8RArIXv4rGys=Sw)mR}G&@DeRXM%C7dTl21KzK&IKMSQ= zm_e-r78B=)yM+qXI#=|UB?l9JG&zgJuQPr)_Bmg? zh^^$R1!9nvFgPqV*PDM@SygWHAT5H#j{;YM2;N$NwrUR4OvEwRS3bHBW&2rGStQQT z;o6$b&x?}bIrwX2!tWT?UwvNm7Ur|S4Pu0k8M#f3?*dl4Ld3%kOJKDSkE~L9()S|% zT|nQ9S@ITChv!+?HZ)Ur6po4T@|wt-w8`aBlb`6&9AIl&H|UAU7NNP&HM^> zaw*DLCA+>7C7|GZZq7%yn{Yga=?w-pe&j`dj~X5y+<;YBnG zSxofxIRGaV_w^L_7~C79d3%evH#Q2+OZ=OTdUOqmC6Zp=H#|i!ML5laYFvk8!9C(HAj1>Zi8A(@hEmDJ9jRpC-f%MBW3}thubiVW z4-wvHLtjMy`~jC+>XwTQrWYaiyj$*i$i2YA*Q2qnV>{QQSpAFrupa4mk+M+2!ya0k zOW>L!`LPzOwL5Ug99N>g1V8bNF&Uro_{TxInietUUF|7*2O)tj;(kd?!}Z&m2i-P7-gTa5 zW%T_u|Gu>j-`}vKn-Gm}*|klm7dN!vGgCEU{T=_d(f9ZKJDa|5^6xqH{R59qO|_WM zPHaI?6E=&_u|MeR!fO2Y>1Lerv2At7VO7@C{51P*7D%njPrQ-A6{*M^miMwJ4lis$ z9DZddw;&F%e z`yT(^K;O9fi}C_1vQ!%W=7IO!2H)_;;C57&vD*;dTiZqG_HGlCbh>bsxKYG`=+$V# zE^I^ivUgBimWtk5Yva2eB@G(N+u>Q|qzCn6Zc{ixXqKd?x$6J;xVSL3)uz6wdLner<93ngZE%SmGrD%oMI z>Q#g&oYj)ihSiY~!EV2b_QK4pyHICv#p*6GQ){B(pqZIPU&jOzjbE6dZ8(iWlh-40 zXzoq*xgEQ|3$-eWE!#~Z)U&(MH|R{^?2Er!wZVLM{$8=jAi|v=%UF%um?ReXnwV*j zK{2wr*O27JuZd&nJbo=|(XH3S-ZWoyf8!WP4H7tpRn;Jvv8=X6d=2e3tcMvakbuSe zGmsh2>S{5nOJKr2@rYn$NB3chgl)ThVi0K%s}-+fLJ{2_4r~Z9-I(fGRiF-?{L9?e;d6%{`8BTpFw>6shXQ<48}OXxjV^ zGS7BWH2QS**s)P3#a+zz9prH;^LtCo^y})eg6YiyU%<$s_$>^G(s4{jjEE)=NllQl zpK_}kuni{tX}+=hZ;3~A-NV`5`?@v;VsFN-#bU|o=G&sLuEzuPp~q4FZv7Far&C&| z#88bLnkn!U6#FT0hF?zz(B#5|rU|C6_fAm)*qGltD3Pgb=sOs8rLw|zP|&m}s=ADD z_R>rTdFtdNX>Y$F+i*au_`R_~uhHxW)F5Bf9XM{DnC_))a6UO(F%rIsvtD>jfXZIQfL z#W^tvrFzdfab8c%fs$KEK{(?zxs?=(8(Re<5N0`q@K%;D5Dpd*8iB{VfS%xJBuAL# zkliTGIhvy}9F65@97j)agv(S(W;RE5j&eB4CDVqbiP8a1(J%6f@Z5jX212^?f}~+=NO-jQzBqb;W-z|mrpptcn^pz3X^QC zT9mxkhQU|dZ%-+?RDp+AH5()mD-M&w=w2;~^))W!zZ`wZ(N`Q@=jdyWzTxOwj&N~3 zdHx+o-*a@6qaQf>kq{KQ!{OWi*o|;W3cQ6lHr9~2%{hPK?l3MRnZI!KD@VU^^gBm? zaP%iHXm>ce%kA!Qbf2TYIQp9-tN=wKwgS$_!v`HlUL5H;GBAPca5FD)w%`b-?g;sC z)RH3{)FMt_j{G?C=O}<99Qz`7fgC-;Q4mML9EEVynxjzeLl{Tl9O0BBNr~W`ksP(< zs2xX99GN(Z=1Am7;z;I5;mFKU3`emX#c^ceD4wGPj;tIda@3xqB#x3f>cCM7M;$rp z#8E0oX&iOts0&A3IZEfK8%Nza>cOr_XcLyZ>uOI{C!!>qWRz+sVNI7WpdP; zqdpw<<)|M={W-#_8D$?1k&~3iI2y>&AdUueG=!rpj)rpdxE3&Glq6^kh>~ykur?1C z>fylDyo{hAOXyiCBE)YDAK8TUNjK{#&N`ZVG=}H?SdPYV^b|)}*rUK_lTZmuat*1H z!xOC7onX0*tnzTRJX&H0+bByhSVDs%92tQ2woK>o ze1@YL993{MlcQN2&E|sVa5R^rXE~b3(Q_Ql=k6A8v`|BAc$^f>yPCxsGg}%b8QC0J zf}-UB=%g)SXJe&!c95tW;!ygQF~2zUZp*po6(kIE4qs@}6q9u&r&qCMafrrB?&T`( zMuW?kva}LTY}DwqM+Ai}(y;Ki5L${~)5+O#R=7oa40q}t+9I{bVa*#`P#05K;8v+8jG&$0|l#5NG!W|NJG%=ERMf%d`9f+b+gL*dkd~4_$&A{2=ik(sdmaBH|l%`_2D*9D~ z<}4ffs#L_PccV=^^{VtHi)@9xt7 za9T`aHJAXh8nClDwYZeN!Wa4nw)0rX$hwV-Pl~g#WSLZgeWdK+2EBk~>RnP4<;pH3 z!w1Y~w-jOc5JC}f+#!YKusNB(@yS(--&d*h2wNelN#QHD$PZn21V znJ8b>Q$c=;b zRRha)Hw*2sHD>v`f#n-F3uz%XX8E>(<%XMuLfx3vj{acN@5VYT)|030G|c*Dv*4q(WMQto^Nl@;e(> zBgGj0XrTPbHWJUB1_~Z7twBoPYoI`dy%s!wHBkO$$wZ;ud0srD1$=t)N^Fu)x_UO9 zR|H#IEA`OnBlu;J8^XMOqZ26fa1)K6=R6EGhTDOuan!NeZE{3Nh?|9$uROaqsVrn4 zs%tRovrmfA-MPD4O45F*0%G^q_ZGza&-C3jt~;Rl?q>QC)LT zT7_Fl;WQu4=%+Qgtjkff@mtx5qtY(n5mh)QjTE$Q0t4|BtWgyo$G9XFZ(MlVT&Qxr zgEr6igcM2Ji6^Alfz-HC^&o+RwU&3Y9v45ne*)97>+JFgX&&}I?I)!%Ku1qvSaqG< zI4OOD1*f{V5V&C6j4I8*yHR`ImeLKa5kkB?iXA*wv#5<83!Q$akbz;W`zaL6aM=2@ z+P5*jC_arT+J;jIMjH|ks$MuHJ*U&*G3GB!QfsY+=Z~QqC`?%Qk#XUYDagxPOKk(c zI)W}v$5SMnrpKZ?ibU~8xaH&48KfT4{|uVk$t>hu^njDusCUr;OlEcOqDt}}W$rgn zi9F#GB!@8{TK78VI^}7TL3vS>Hokwz6?#TxZMPgV^h= z?melWwz1fWMbD-p(9;VVX{ESX+jdTh)M3$f+y_Xmwye*G(j=jsTKl2Y-V3X;*XodU zCiQ-u^obA>jg)CzNJL;GrBoENRpQ+t-;X4{4vI*D|CYWK1ewZ96#Mp5jL|Cphn_3p zQ)vShYKgi7Q~?XM8i)7i2!0GZ^trU@kywbN_Kp6i?8QZ}y^{>f*S?OoOe%dsAn7H8 zQH{JLb;iRQ;3b}THtw=CJ0t;++O`DzXm61IWcBuCX_ElyRad0;ew3iZqLm`tBqR0H zNS@8@!FY8SWwRwVX|REBds5JMsKnuGvZkJbgw6*h37(##qzNAX3v2hc+=gYRpmM)^ zRa#_j4erNroV&3UZ(yoj9;t_KuUh^|8+LPBYi}$+ue&B~#i*(Kf2HH}2*>>|F^mad zoxYMr22#e8AZpzx5_xRnSFn9S{rD^76ILB=Ux%5<{Jxgbw9A&A>{?5dkg;E5bg`T* z{uPDfbnH&R3h-Q-7F zVdT~`&@!`Y-$*k;C}S4CL2COG zU^bR}n$5fcpOe_m8_1N?O!y8}A{m(s_2jRmpjDN9d<`AyAS#!*$FN3;JAmQM zoa;I~#uE^X*7db$JZAJAsxy|?|NI^y>!ez5N?Th%ajEWSX&9;8;6)qg_O+q+7ybaF zn^3bM#8<8SLxNf#)T-R?Lz`ArAH$tle@Y1tKR}>%xg&kAV^8|ZVXI8nah&G9R1Bwh zNO~l;VJC;kq5t3p2RBja(p0-3kkJZMBsZZ7X&mlAMmYDIGy=T3ixa{7gM8Qaj_asr#v zLLLhhDKMolqqkhf608q#s^IKQ%29u|ls9RLM>uJ57$+aEW_sgV-QgzehP9Fx2|cyo zsKvf=o=#I_a;quqGh(^lU(VBnAk!UXmkIS@_X+i7 zRx40HHpnWsXBRS%5R0sGFm?qtf*?Gqeqfbx3ga=%oa6{$pxV8?9N>k00WA~ovL4%j8;r6?Wm&tImDNsyK1gtioFxoV9Vv28y6k;hXL+8Nkj0bB)=jQ7u!B#?z9Cc# zABSrjO!^}{jNQ(VQ?MVP^pbaBKcKFc{2CH&Zl=tHC)DuXGA^!wu48{$!eebC`pfH^ zBg(f2%m2~g5~dG^$}@yf>VU`PO#V&)glo^6&>)oR{#|wRa5)qg((@8<;R-Hr`sE3^ zqtJ=XJb^;jNzE83Uldr@Xc_kykEW5yD7l&y6WlObHnB_eU*s6sq|mOQ1M*{G>hL2x zp$VSI=8l%50`r@Yove1W+&=K>Cge%%HjxXOkPBJz7$k*@44m@XtM^?y7KI7AKu^gL zE1$(_=PxltnnSc=c6ltaYBJkA4ry4ztmBZsr5cJZbBpzIhqb&3p2FFtHX%=If~ON3 z4(DUMmh_a28QFN*#kus zT-5}xY=T!2W>q&aw5qntCg|>*w97+q%Ryj{+z-nqKoaxKm9uA4 zt499N(px<-QU0if?mz@PX2IR}yNl#SI+X);V6pruwW{a?pM1IqN=EiTD zJW{&~0MjnsQKQGM|5j&ClfMyk2hs5i#A^#RQw?Z2pOHI56urnHj8<baeE~S1Tm*r(PDcF$&$r)T!a}+I1ElXbX<$ghddK%f!b1fM z<%&erQYf`5BpEt_?a8OaN}2Q{6_JLXW5HoS@(McOY~Pd zu>MQjVbu=9Q5zr43YW-uzz{JN?l9}~@(|tK2=-L};C8xuZu7p|{L5|r?KYc5GS`=F zE!gm}`ztv66BQE3zp4)e7zMn1NmP7eacV)dp1r?BPJmv`=J!!pj7#Mwb%sdw>7{aO z(jS;xiMA990G0AY7(P`fK2R#Cl4rxHts*)EJS{xeUQkRP`uSeleRgbQh?;;B7p=$XtFHNme8&R{mxy^%A z)5|C)fePf1yG;DFAqBHpa%O{?S@^)$RA_f3!~a zSkr3r!$Grqtc(89y2@ic`5&!MdaOyE?_uG$J=W#_XdS)F9rCIFXg$#;ntTW+s0V#9K` z9It%_YoD;}zDFkQn7MmoNwYAKg~XC*5$Vz%bPuWQ_8vJ!vy;gVvxmL1tYN4{dF0_) zDz`HnEI5O=sn`p( zvbQF>E4yv>(o~XOmoqg=rj|GG=cI=+z(a|C17kbv6mVlMH)^?YjT?dcH5NCTydPa! zD%-hVUa!d>#WMED@oVWS>RV4jOL)!!*;lg|qXk3zT?gWB|CatK3+dbVVI6_b#H7h9*uW4==B&(Yn`9*c{!M!a0cnyjzt-# zZiEhmbjGi-!(cY(oSfO#L!$k=rYu!v+#kz`lh31% zY^zqCm!X8%jz!mD-bZnvjT`C`X>c6HhStgF(4DpYm(0v22(p1nf7D@8jEO56bQ*qB z>WPu;uk&)7wFhuH(jWhld&6z_i|CYbqsT?He0SB27g4KxBsd{7AIp-D z*-edM-9MJk_{0KIj|+9jL?tx5H9pC^I5(HYZN{_i|Ay!Ub?(3ANrKLb5d2%;Mwf^Z zlTuorIZmW`;ykeb9cek#+=f?B$CU_(EX zAA^eL#?KJkjtr@UL!Yl8oja*Nd?t?<*tE-Xr1n@(8q2sOM`_*sSXT8Pd7huvX+R{2 z?aZQK%e=pk@rrg8whwDAp-#;iAECz)CFdoKVWGuw30Zsa66TWW?Di!&LdynP0HACj zA>A6tw6yLacPBDN8MuHAYd;hUHvBS1={@N?!jEQ5H0z-fH5?Wl-7xJ4}bGiJ5JhhO{iqRi=6N;ba9yFRJdkRKxq#*ujcEm5>Tf~p}J!2}$ zt3LlPd?dFsJ9!29-EpXsj9IQdiU0=yK>h zT{HeL#+>W88+!QHs2RQ3#;?(j_hKi%MvC=f*S?mo1QI6=$0+`MNLKfaJT-90Lw=3= zR?ZB}dWgK|TRA3h=tJZ|-^roT6f&BPdeZjshuGTQkR#%Vjg~@)%@aQ=9K+n~G;i&U zUjVb;kb?q;KP08zv&I=Y;vu%9H{_JSCmtdT-^uBLBOfA@P#p4fd?yD8SkEf|UjEtL zPh_<83uOnZ{IDE*6C)95!zTZT1RafgO5`QNSoJa)28tE7Z0_rD!|*MX!Le99Mmf&A zEf+T#akE>u$zI*_liX9M>26~kTuTkQuY+QaOPYQ~GE-~o$tzBVB0{K|^{ZT?tsCD# z&x}^-4vN-THuDZbahLhrm9Ge6*p0jLCJ?Kl6>05a9QD6t#KraR-;?QxLc=NTU+y73 zaq61;@+5R;YXoJhFmBB@h0aW(lNrgf{gp_T70}N3K&w7p-7F}t3xV10H1uqe1*i@$ zB}j+EiPH_rdBZqZAo|qUh<5XpMwYh>nm`-$X@= zic~H5mv&K^ro8S@ArX6$VEDG&CS4&GZ;zY(Bc>#vv|NQMc_>aV0ga|+$) zcL>XLU%3<4OA#6F9#|kH3tTq#=`?TS&t~c7}BUQU_!SxIME)YWYGoUdxDjD zU{4NFXu38cL|GB|G?JeB8x%=ilhj{BlzxJCCk(}$lE>4kC~Rn`5`^x;5vrv4)5M?Z zCZ)%uNH*(P9O*3R_M5vp7i#;Hfc6ucN)0MD>2WW(I{{c#3gH9JDV z(oP!d(pDKJKwBFfj#}MT$DbJxk(ADc5`@;D1=irq{Ru%yV%0?=`chd*Fa*E`N&6M1yA`tHjm6vfveFY>=4n~^ zgjDktB`uK7k<%ZgAQiZQ?7E`#eB=;y75Jl`gUE(RmTFd>#c<$|Ss5afF`pRZPDf^q zQQ{5d@W>DI2O+dI^(<2WY37~pcH0sAk2^77td3Fgp%Ld3t3-s8CXfJo^43$L8+4mnYt}WcTEH4inm=&X}>oqog$v5dQxtfYoi1Lj6ua>%&v`PP1q$S_M*7$4>s&*fli{ z#@xnCIaibTK(&;|r>+(UvTyaqMsiYnE$K7bD`{wPr?*#zwO!!$^EeWW(zuUX z8sTQRqBk1BuZh;LO+qWSkVPk<&0fedk`SClY%-z6YE_c*MY~5j9BtMt=h0?5NZecOIGDG>l zW{hVeE0kHr?! zURLHPahdWQ#ST|qsj0|iDl9Lv=M*?hrDgUqM`FtXWv1d1#}tRFtkhJN?=Y1(3hhpp z(>2j#FPT_gsL>~s6cw6s97HU4<(8L}I30Njrm6YP+Mut}-bV`aT&t8z&=qb_?{IjC=eJ;>@^J_+pTQN^N8*{NWnY{FWL z(wF{|T1xP+Mvr~g>Fidm@`SFshOOAASOcxOMTHa@WS+gG%m(t&eM)>#dk@)FRAxmA zk;RRDO0pMyM81wmm~}#leWJ6#VJ)nLljn|cNQR&W!uA&l0p0ya_oc02%y|}o* z$zw`PkG!E+x+WIba~uVw)}lfuvVny6>oCYsmS2=-Dw^UzGUnwuT#41~3pJY6O>>a@ zVQ(m%0_%m>`@Q%LCC1dP&{@ zqFm;n$dg^y{Yv*o5)txpSDqc|k!vs2Je;;)NeWJCpqG~CKq9%=xnD7fU7aqZoGaI1 zonkL>QUPil+`&GH1K5?dSOLGWUkM6HMwxI-M55%_b0?J+*h{r^yT4ztM5H+jDV-3i z;_@7PpfXZ=l#)lW2NaX3Te-_oVlU-B6!YR_^%O;IG{wfN%ds2 zV_I2>{ef^CI-o@KN`>nZM_G9Z)fg&U^$Gn%r>qi3aY<3GqqMZB#5C2eu_RU}ptjYM z$)6t)>(CU`p8{}tvUIAmOiQx>Re3C}eU3fPT3D1Xez3C zNtvl=g2xwA=R}f>I~7)hTFPCJja0IifHuZw#Q>M9D7Ty~RTV4ie^410lH9<77?e13 zwOrqRP|1*bqIT!y+EK=k1J<%4)FQ1IpxDp{No3z1R5Amtj-mo9npSe}nn>h?LrQjd zr@V4rD;(B5#{@JhT0=nA%MK|Whorb8Rp4|@LJ-TQI&&#<*h^6yQHiynsHoWF zMA@2_Se@i{Lv)Qq(%K(ZBKx&>+faQdEi0mAaHP1U@PsMP1v#<0gPXAt5xf(+b6&iO z9oM>BgGVT14p%9fO7Kifa?3*LkVk>Sltl~ zkVZhdl7!7CG}Ap>0HE*7RqG?(bw7N@SEpZlVb(olnjw#mG9eDl1xCK?fWu0ix)0(i2 z$CRk3bo8@DE(g^BYUQc4Q#kEtv$bk+^qA5k)<-ILmD(pb(9D(Cr&~*>yUOg-tkeio ztwQTc-7R@{@0gO>t37%htu;fFPaP~Qn)OO^$BjyUG#^}1S~S#dtxDwBxtt-#mB`uk zjoAc@s?c7LN2tjtJS4HVPfix^()rMX@}3Xl=&R{K?*GRi&Wur9Vs%eX)^pjEex7{O zx-%Oz!gYPJk{|AlT zUSPBDD1D&`{mvasqI$Ex?kH{jUvA8?gT>ud660S-%q6=k&l4&&19JxtINaF5QTFUz z<ujKc5jKYS_&K-W=A&nyA`*>qNsjO&R^@YTD zH0$`6GBu;9iHy<*X-^R;;**sok%NS=VYOa34-C|qipV3B`BOS!tIOSBu~(441O*)TQKJ(rywMjhKA3>nbwH2 zaSiqB&VqI3Q8?D;(wQTLSJ)DrIc?N_aNA;)GNp`aX!Y)96&^W9P)DT-R8kQ1Mi2D_ z@tfV;9^z>t%9;QV={*+VWgZmyUkH(@a`LL5*+~Ak>^U!UR~+d-?qyC+_BS9So_4$T z_l7gYmTvL5t1aBf%e89C9gp^ik?TfruQcRJGTk4CUKgw)<8|nWz zvl`58VxNRqd1}7H)42JgL9@l$(uve4#@VdMV2(BxJQ#>#R&6jl64EnlTamOjlQPWH zs`}fgY**UMAeJh*_2j-Rxw$zg7`2Hq$%OEEqM5~>Y;JC=^A*_Sr(=WJlIG@t&^P_G zxp@&ZBJC~A?S%EvwKj*N%)Hpb+(ir!5YRaHbPFNf731zH+yVnyuwPr4D?)k*%}x)i zwwdUk$FG}gfwwu`|A|I*IA9bz?`=-?cQ&RKEDZ87;}@d_`NUq@+9D=h8_=>FyJO`D zi)~D|slq9>MviMIpmv^D z;xfF8AFI*F2+ilPFms$U;O%A^3T9mstTpfENND*p zjKM;ySe70W*8$h5xnkmMxPt4on7BAxP4!t!TvTY^M=Sd&6YK@04l|#C*61e*erH%f zY+MA|_4wGheBmv1b!^=Gdfbp;x5mAS(D)|Cm19Nr*~GZcLa=%yF|LnU@Kc2malcQ_ z_iFQajXp^5nm?>YA1ru%nNy<=5xjOxlxg}@qYo9ljy21y(T53M@6C*JIi~VOfEs-p z!Rv>?62@ARW16c*-&W8!?_Z;DCwSc(UV~<*MsLEAkiNuFqZb8zrkZ^wu4xqXha(5 zV&o#U+-B>w(n6#{EQB~fco`1kGcbf7pYJHpC_8N#nJZ&^IbG#t&Vo|G;M9aGy{I)6 zTJ?s^PQ9=~mp2|GlKk1B?I4wn#d2!gGI3YF!=cvFP%R1d=NScsfT?1^LvIG)y(iV)h4 z;E5$7M*X=$o73#dOp7=>4pb#mi@5(dE$qGRSeL@WfZ#icJc;Y=$SI%bbWJD{g0>*w z=HA)@p3w3-ET!HB1wvRaxXWB=>Ft@KAVv3))A-&+w1TG%-ULG@P-6RF{VBI74}lCI z&m>bH1mE{AahvgJFP|m^gu@qQ08QnDmUmh8EQ=)t%q!yuxN-~1G0(e z2I@k<5fVRumI5%d6CygX`?D-Dh%`wasLcz6pjwhV&@l~};FH06&bCC)-U?FOz#`W~ zZSE)-c7R_Vgis5SiztL~^gSN4w^E_aaV`HXM9C|0V%bcHTnOhNV9kK1N`w`qFLn?u z&|z#Wg#4n3bClVIuudp+z5Dd-2l12vUS}Zf0=qKX(h6!T-_N#0&Q66e^AK%rAo#{m ze6sA6-MRUKahjIK3J9eR!Dp}*Ee#+lt>I3_2t8kD)toHgOk02}6^s^GC1yD=YbeEx zzHB^|7T?9-F=t_j4^d$#jJ+~@uZ+too=uYyduf@_;sq{Vn_LLKD1ETTR0nG&Q&2zJ z*?RSXA0FtvzH{X#vNeI-^!18!GX8eUT3lhRQf+J>_wyXz~ zOdbp?%Ny^Q<}4E;7pu8*Eva6!ty);k!^o3TAz&=rD8tHg5N+QygwQ+;b1fuz$Y?Dk zhfOck)~JOrVvHN6O~){g6Ab%pNVYzGSH=xT;c#Fvzf3Ts@Px1qM=Fljrry*d1q?t) z;x$^Ky@l2$1w6{4=3A86TJek@USfBZ7GV9Tv{VSa34bhZ3YGNGsc;>~2~^O-6nBPk zQc=#+LdbnB`8lB&86||GO0G;Cjwp_IVzD{TY0sT5v=X(b#}S!()+Hzbe6bpV{Ceag z$|HiboFxR>;B^NNY$VCJfZdyKi4>k;;R`J7!d5^?QazhCO-BA1=dmFRETOaKYT+lD zWhD-W;Hw2ThS(`OLCfJ-Ls%*i0w1GPU8#_5sn9A}3$PZTGAwck0l$JdZiK50)>Kdf z3MsrJ`GO`|9kVSH6|DcG&#l>h43FLq#y-+Gc71^*#JKPc^O@`+J0A^PaO`rFH0=vjjp|F=i^W=DlJoV##WdA?C$g7=v{}_uc`iR))xm^#VSjtabmYE!yaE!{aHF& z|IL*Nt8&=+RhBu%ExW3oc>3choA3Sldz;@AMr>o_S6d`wz@tAMJ~jOP?D!jF&$S-Z zeVDp(wdJm0`OlA6)SjQ*Suo|qSIr*HtV*x0=FM$o(lbwA4A*b};KM(AetXtyRr9$_ zU2DlU+CDMbTP`RoJM`Yn-_NL(87zibSmMbH@0Mw^Qr__1c%km8u3-nNtK%}!m!YA_ zDX2_}3Qp*DWZGj9k8jvD{MfzCi`1LUGEy*3f8RSfC#%!S9k-4t0X-_-V#C&14jY#Y z|NN(c=aMu2GvvMbV;5A8XKi1!{9)YNH_!A#SdiED*+mvz_R4pdvflE&v3dH(q4`fw z`)c{+djntoCh1LP+F*(9m3FH4z${XGYu0<dcmi736LD0pi>zy$?qnV*Y-LO%E fdSO#PGxPCG*oWkRrA4N_upqfhmo85xbx8X^Fa;2# delta 154392 zcma%k3tUyj_P=vD`*F_M`#j|Rl7pb2pd8Xt6BY7VVnS+aVnS+aqJmjkX+r8vQ*RK; z($a#m%)$gqwx%Ye=DQ%@sR^ZJrG;gsrSbpH-UmhR{oT)>55w%4Su?X{&6+i9);u_T z>^(Mb%X=(uKAUfv?=#>0kx=rHX{bV#cZA0zyzrrIm%6sbQ1gW;4lEDa5f^ z)T2`9#h%gTR0@L`dzKDqLIit`E@{G(McG?rs`sUte;kGPBSMVS%dKTYPETR*Ou^;np(k-7Ivye>hV7TXbk~ zAN+oB55PSL_YmB}aF4(}3ilY?<8V*FO@*5d_cYwIaL>anp!{<};M~plyaX2w47$PH z54QyFO}LG4+u%NfI{^0;=*ZnEeE$O1!qlRL6V46iflG!cGMR0Gy zmBVd^+Yfgf?suOSb6Yr3U^rY1Tq0a|xaZ&&z%7R>fh&jm7;Zn@-Kcjq{8;!L2Oget zNBH?W!gKEk=iLm`Hy;b{(ZQ`k7+XSF`vqURzEzOv-K|2jy?G4^3fkmVk@VyfLO z#4w`7YSil4E;!i=y%burP4J_f?Sjl+rIgQv7%JH=bT++ardGd1gt%6rjAZ2JKfIjP z#6A&1h1Yq}l;74I$lfrD)JrI#+C4%PE7j5Vf3q3dP5IyAI7hKHMho7)vjxr_f=7J^ z`E1_$*3zIIpuoF#ps|iOCxS|LgL)-91heHm0C4=?r`$b4AbI|&kcFW$I?KV?MV34_Zmk=Mm59vceC5#50kvNApQThPo&*M#K zZw5Q;5`u(-NK}jR`}$JJF2PSY)I4aWnqAe}`5zr|9Rdmn1AIs`t@i9~Rn_ycEWl$4?y5&zOjEjY)aevWV z_<8_&qI}Hk5*HsabZ#H;&)E;0f1!%~!Zg-Ekq3l8c3JPt;*ppL(hh(|ztZK8Ff5kL z@{=j;q9U{3sQPW*+ymgPD@L<^=S4=4XD@o;4})xfa!p(RUbhM1Uh*{ z7$b;6ixv|p(bwclX-9?5f`srSBiwLA2%@l~yche1Lgc-Pw$&UJ+?4ktNSXAZS*Ghp zL7szK!q5jFf)qi=5bXM)S)tCygo!MSN{3}<6i={ecb^d^o0&qT^}^Of6<9X!IQt!8#~ooO zrF@I-DgOp7!XJg4-=h0ncR;li=)rG<5K8?P5I4ann`c0rlV*P-#Ohh;;5T42J? z6Zxzaaz|;Q&B91-(R`-wOLGE5jWRkZsal`&LMqcrz7vj^gbzWcY$_cp`wDJ+PNMWP zU_zzNEmKuT2gc(`yHl8`(=X*mbfSac`BL_eLVUYpHyRr`dE?;tO!_&(YP0ZeZ`eT< z4u4-^1A=y{K4lMNE9o*y5uQejlWNV(mpw$euiAZCFG~Cg9r)q(#zt$il8O+v6}b|9 zDNl=l^!v_a7JB>*7%Cm)}Po7wD7zLWou%iG3K0;{^p$-4<2WuE=7x z4~y5b6mhW3I%pMs;v0;0)Y1dQzh#y{gCfM&Odf$g_{^s@m2WVIk#norti`*!g*o6$2UTOj}~aQNrDzhn*s8T48371qSzMPsNIH zjCG;Xc48OSl}@$;uHCfz+l!-^a4(=ksXAPSHXA3-VBNLEcySD4NmSTD3}roNJ@-N`>3>)5Mk@r^36%UTgr>a_@f4b&n`9_JH1MO6nqx zV*@o#0TWB5-QC1**&teXuQ<^1Aj;u9<)n&x#XvfEKF~?dsSuN%?qIw4?&3B!n11Mv z3~6*INo-{4bf|~8lRcyr_7okA4WZIrpwUn|*-H#H4HM}3i|znYlEowJVX99ShtRkslNrClpC%cPYLh!HG{wmcvXVUKC*KyjzY#%i_c;y@D{N8v-ovur%w z7>aItT$?gX>@BhhR540C&L&byCU~M`qeIc&%@9*fY!Zc!6{E;=CT=_sZ7to|g`J|+%iGc+J_n6alg+lFH0rgN|JIMmFU zl>08~teb=h+;a^|P}+EuJWD$>UK}G~)z)K*IM;+#TjZ1I!@R}eGM%0#hGG4tXH#;- zWo$N;=7@3rb5J*z3tWb{ASijqJWusG;IX;1bRM$1tFe~L%N19!JPMu;`sUM=>EdGc z0$rPqewe4Bk_n8>*A~qXx0=`jDxHa@X3i9o*}pV=e<-jQby1+@%n>J=*g`rv7o{vR zMs-cNY^DKuVl;b+rsSd4#dJAO+<*m3X+9dg)M#`~z9_SQ8`zipVZx#_U(9AN)94q( zFIWL}m?sW)6{00BU>^y`Tk#4<{|)~lM7KmxZkDu+Qs#@@{g-=_xWH@5RZNBR#jzG@ zN`htsLa&%F1_^vxTd8$eApRr@uOi(>x&4A5kC%ug>@}@+iFn*BxDhW=sVf9xrcj*7 z+|=$B@hy0VUIFi|(s~q$J|?!BQkIMJOs@;{?{~sm7uB3MYZsS;1X$g;NIb<#=n{!r zS*f;eh4`GEz3J`kC9P#Gd9CPS>@6NcYz_CKD0xatjL&sq276nN(8|||^O^rUz=ezZ zK5*PZuo~fLa(!tEq|EolFxOgy`4n+8otC~YMp)iOGzWLnruRk7f1NkTbMqfg+V?2G zOdPB>k9wa+1!`By#2FS#8DKd>yNarnKx$Y7A+@AZ?8?>~GsOo~Unve}8?4D_@+8=ziO)S$f;TSYIqtJ@&=#nzZ-!FE8(FELGM)jZQSXJzRh%KYb zJH!L<5Q;Mps{mpgsauG#Y8`}^QT(Y`$BXz>NA>qlA&ZQ{i+71LbQE}-TElVQKw;4? zy*^~`&9ffRvsUaDcmCffClr5=xh1F36isBE6;rBWd;?46QO+um?h1 zPi$6n>E8bmxqaV%iTtmSw@2PMsJA`ww2t+eLt>P=5d^x~)tdS_=I;N|5^8wU1l9VG zIG`wVmA=$&R@8^hiy{>D9F>19nl<@LOosof(9ADIrlsCPJAt<1_>Jg(t_CF)`42`pWBcN0UO9O&8Bh0O4Z^60YnzVr}R39w8#y+O%5GjI^ z*TdfDda*wxhO%{N?2>YS}u6^=~_K_MP#aQ+unsa$5T|O;g=@lVmvIA5RALaJmL|gpkROTc4Tnr-R>QxGOtk{F-zc@B?9o`CCCA~<#jml1b8eE% z>`O{-Esga*j2bvDN4)+~UL!?@Nukux1=>%}K1qgA0I-1+_K*{6j}lOzuBU{#JrRG> zqJY71Iuj*LU?(W6jTFdE(&%X5^A+ujmWZ7)B2UvZZKScTGu~>x_WEb_RN5OYMU$ro zmNuTY(i+$Y031b1v5#CF18RIjSus)+`<6#X(3%*@X*q`i_{3(RtZ1l=H8Ii(24lgb zcIdM2$iKZbB=~!PaJC^hH(V3jT%i2+(zomfV{*-;)=q6H~l71 z&%44}Q`%E18WttFX<4F_4HE#n3#q>g^yuAEM@st?#^WV-ftFnpBp68UlKKSy=|#Qp z4%Dxb+DRG=Lx7IpUtaZ~3$m^1Bq^r9p{v~^1yEHdsgLQpKw@X0M@{rCrg53U%v-K2jn;tz5=}^w zy0exXY83OOlzebWLtmz7dy^!EF+V!mL(-VPwzQ{o*u(-TD@B@#_1(!7&@#wCB-lVC z^FAq_h0xObK#x$WzYi#e87ZE<7(VXaQmQLlG=@wouOC5kdP~z>Zf`Ks>$j#Gy-`XO z&)$iz2fIkVmQ(0Zu1U3_QnZ`3)nloq4~QCL)RUbf%G&ilQZ#eLdP{2O_1jZoKWV2c z&Kr#P`W;Bs>DmJz{ymg95MCE;(m)9d zqOMwQs`NKw-ENW$J0cH)0{7CP2c^ZVJLNtub)qGMF$R<9(qL&17Id4^qz$H?DEC(} zM9WK;PBX0QMh}tZv1FnpE^Qvv-@ev2&q4oYug`17ng)cum+5fx>DG1Nm1RP zUeicUrNoiw_(3# zRB5pAtU=5NRM^a?g80wTzNylaSjF|21}e^>_0u4BpC=&)-dq};gPQYbOOEuiDPJu5 zr@AfW^TzY#!xKm)>CW$@L^ScLCl1q7LJj|>`dOgv z%XEW#1(aBfVhX9lGg6%Jir${cT)VH9^9+;;Rz%yMMT1sT;&T9AO@p38Xc<*MCw;+| zQ{im%PcikKBNb8nGkiGAkxHa95i?K@`tD*;E2wBA6`6MBOKI$N@_zvoe8XsD38!ZQl`Q6Re<8a2!V6NePzq#W z5Lp1_B6*%P9}BW|3&8nxNrC3#`O-McTS(_qvCV+VLmbv-fPoo-PwCDD;QO~JeF4yW zhsQ5wYk4S;QvW5LaJ`G{oMYB`{r3!9-sfG?A3A5@i_#me_1?q}y#59QsN4Xm;2n$2 zG%wymg^d7nQr2RioU};V%RVIGC5*a{DE%c6WfLuZ33_8CwOb6P)OchR&0Y)*Vl$~r zF&%l9U{={;d?()nVw5a_2>IBEs96GiU@QNg$F@=7QfULj{?flO#y+_zMlt>Mz#Nu# zQgl=1V{S~3FGGaxpxl=+byZPh0UBTaGAgMyqCVwO5l|*m3Z&OuyMTRji^y)eR3Htc z6)yvm70V<=ODhD4EqefFs6ea$tv~mQlqT#$oP!XKVEbug5meFxw53QoOkE2hU2}@S zoTopAoQhu#UO2K0!uAkPkD;7V&`}l^q0eiU0VruX8vHq>FPGLrvE+;#UW20fDDMa7 zhT}q*tF656Y7OrGlFqz>mSq$p^IL?cVkWwcaZiY zmA(Vj<|oQui_k^dv=+kd5+%MX9cMplmUS4}P#xR6CrzWYchG`W?@0rw1Yckk*E-3! z_!%g~TNX=xc+ za8)`xhte|!gaj^IO9+TDk0BC zDM$E+*F@UsUr^`x!iIiRmK`T+>X2jQ2VsepT@<3;&Y0@^q zqF1J~w3UN2LPt#8f^nqK$Su-q78U879Cm~4?G%ozd^hA{NJU`zG31+z*ZHT=l7mv= z)M!vLS~7?GBFtGj5zY((|5=Rk_w4s|Dp z)K8>Q?ScWpdm_Z^hkDD7L!29~NoNV8!cQvu?d zOpy{<%cKz2nhL9=DE}w`-`Vlew66-x)`o6WVO+K4tqv^8x!|O2S+4|Aa11PpXv4hen>?@o(h|=$;tV2>9mF!351&5>=mVsVM zVudjn14*B7J>S^PTJq;o6~kTwt3h84qAfK@O>5Z-J6UEJfHP{OSZJ?$;$WUQ2I^{X ztu)Y*jskg)W6@L#isjWpGkl1a)`C<+XnQT@vY~XXRvK&?CQ+-yJ^_^ZrNp-y&>t~H z$=xvTm;=m|eHb&%aHH{QW);)fW?)>k1Izo1hf(zi-Yvcqdjw*8B=tBV#h4z!I6iJ~ zOYUg9OxybU1X12Rtbb;&h52CH5h+#}1VIg=N=)9zxEHe3b3?;wi@Pjg|CqG8%$IxwKjnFtA ziZHfZR~?05zkUoWmB%UnI65%-I9hb>X6!@_vA)bQ325*+3Kk7=V#*zaZR?zY5KL7k zz`jpV{Rt_`G8sU8697QphbK_dNogClGC;xzDwkcbif$D#xjbh!L+4FAB_;Sz^=5b& znS$W>f^Hfu{YvT$eYf^2bRV`i00@0I>l8G!C-qTD$-Y52?QvSFf##cX2FXtuP)}>6 zXQVh2G~fJh(G7KHF(J(2-=UNj2X$VllahR(3G1mD-y-!{<6FU!ls%^*zBg+*8%V_h z5#~i`jzkY0Gq);!Jlf*EBWdm(;XDdIFNL$3(OBjC8se^xkzgt`V3ucA6x%(R% zUxE7r?!>{y#{Qo-HjerNJLffxjrV`q*!bDu#>R`s8ykyHH#VM!+jyq2G52g^<6O9< zaHVjY;J$}5)ipK-!FA+*ePiPcxHjK3Hp<^NHa>N(vGEhQ9^W-KUV)qVePd(ng+@o? zu^$>6-}(`Szy(~=+W#uO#8{!W={M=DnY}{wSJCA1tC9!WKE4M+zlWDlR5uvv;wG3Z zv#(*CE~nDJzBk$=6)X(+oIsuzT0su|BbiO?wWe7jh|<=;I^vY%Fh~Ms*|c8%NieOF ziazMvx+t^QtW}Bf0DZ#-g=^6kd8iLo40=sYRfZf<r@Z)w$j@)#4z7DQ+6VCJ<+fik063W8P1SeIl3$s_0r z4*10m_r|T$i<0rD)d88C5mzqWd$pYIf-&_ zwppuAl%qr}EI7f6yULrfq`+sOhK8NM@d4N_jMxL*-Jrq7mehpR? zYntYqDl1mDS3?YJ5c{+#&&aQtP5UMK=XG;i&GWpR&A6ugmUR^7F8Ly*jYV%<$dhr3 zp_15(GR`%8BrDpi`SL=O5%WE()P8tTPT;!@r6n@jyI4NQya7T$rV)?8vN&L|oS~I0 zm9bve0YkN_f6K6Xcmv4=@@ze@R^CH3@5nVqLX0-MNXCgMY#+TV$7tJ@$>(gWOhZNb zP8@v9+MOf8A#cgE_}&~xq4FKM1X;AwwQ?`+BkME~Xr^zFZ5(U(apas~4Wg0?IaWOY zx^h*KORR%5+Q$M*dWF0K85V7ndwH7~sG;G@yn!gX_>mk>X)nsDlr~)+r&Wbo{g~@e zvw}XyH;!3UgCONwe?E0b^Obx!nD9gu!Ll946*Lqv7ENeBN$aN;Qwi(!$ z+V*PsEbkYT5QhO_0n|=8L-ID4oU%=()B~VqrB-o3{>6tKrqVBD!cq>NmpP6$W0Yez z8Kr?8*K)s<9VT{y@{h=;*hy{lQ8|=T>zPyX`|zo-(i*5GeIu868}F+%oRgQ_3>17X zmjxNPg>D*Q8OIZVXDFR8S!StUHEYKy4YZ9@*=cQ&(=wN_GhY8|uYcC-*LnSVum6qV zYYUy0JR8-mv}C}7ZB{uUm;Zh)mb;xRS` zQ)Z74b8&?wj7EHn(U5t+Wrk|Hi1~Y)j(mcl5)k09jfV;p{Qp0bjwU$P2@34CwM7O zq0N=r$)_yCeX+xmxXALHN}ZF@$f{yXl@$>ArItW=iEpC|wv}44fmZd~mI!UYo0b}0 z(5>{BQ4o@T`LD4yMkUdP8;lhdk4HkW`_HDFL7hb6wESMa$l^ZO7bG88~ad66ko!#;e zEwM%;Ldm_^(v>nNfFV|mv0$UE(uys&&p@}^zMLp$=|`4M-g0_3%MEEmNW#pr*>Y7t zf@_zplXm?R%R-A0@YPoAwfI>8=4yi(p{mxRaEZVJRQILjD!xx1wnQ|gD@QDTw|7Y> zgTTWP@)Hd(NJMw7A0|OD5@&qu=JZ)K`)B2n( z0=aG#8%Q(0wjA+-QRZ1o3HwdM%=C*tyP{qG-9jezySC`6MIasf||mvMh!auwqm!l4tOg0hOw? zGfXLxc8}fqHD_48&#L~ma$cR|Ydyt;zfiu7>ieM?GyJVHO!mKq*Pjz8RUeKx8e9=$C2Z@#E27Nnw%O$A zXLHl_Ll!4x_OoFfx!#&aHHWPuieI$2i)$>GxV8PQ0`#PqL2iCJ++*G*1ufiRP((WDJ#* z+lp!qmvo;Mx~iG723SL3WGd}rje}_^vY!>>v%mEU>`QuzY@}Ft%1_vT)FW+rB$f2B z`cYjU>s4$#>hX3X{z_lOLz}_6ae(y*j7oZ<%Sepv-;~MMi1#z%XAfwWDVeHDZRM0X z*lNc9TSbE)PlsH^3l%U%C}zI25wkS-6lE{4HL_ks;C#PD!OBKHpKd~(kQ^>U8OewCxFODt+z`Ia6N zL-k=`Fr}N-uejE-%1}_$*k%yzIK%|CY-;;vsc|?@X$#eArd#uv8s99T zgPuT0$e{wsnna%IkihewvJO={HUmr0!787&#!47;Qwptrn_x^zf5Eyzr=XU$9PGmq zHN=cDvAeX2`PKw84z|`Ww7zJ9RSCYXfiC1Td^XihfTj-yUIjhMTiV_KQQAF5X%wAj zJ;#TGhZM!yRZD)=S|=kLChlpREeqeaKB*5v>GnaW#lK@s!WJvl{%z}R48Ly1@VocU z;n&?5eo5TxuGOrw266Rx&IV9C`2%PhoJoo+t;yusVC5?do}wWI#X|yZutF=<^{P&A{f3*1DzuAw|)uKC(h5snno@@jP0sW*yZ8p$*t#^@HZ6jjpv$@M|{SurYt$ zIvX`)eP>PJnZL7c<%4(71&lLH&!5>sDfJ9Ct(RP|CUGUQ_BZPg3Txm4TFYv%hWfx7 zHwSS>66SJ3Y=5o%idErLS9+L&&5J*+$vPG7Iu(}}Ktsv=4JKYiF)3QkRR~q&JO7t; z4|3cTz_)V1oOZ}&){?GU5Arg(+P>Uv8{h@Fe8d(=7sH^l)t#|Tq=i!zrIOhSI3yIL zQNZ((*=B3X$Q59&LqPWpqzhp-MJthQr%f;>LZ)B?(q`L+9dG`vWh%BlW;MAPr>1BX zPTPkj^}c3ty|r9ln`FWs_@xQ9x1fsIa*9)J1Ju6FVESqG0X8fp*EnrXIu~Xg$5$=$ zHBX4`go(!aB65DLZK0Oe$>uhx1Dj<`rTkbM=B(!}7{O(jf9u?~y-Xd{4CF!Y=xc4O zGO2@`C8XUg5o#<{o0Z$kcJoiXN|JO@+QfHLqCRRP~J|nlf{t z!Y_Q-w$}%?$@E8TJ8o8>p#oo%I-yziiCXSxTaihf)GY1^&6R08&WGhK9H7fSW^AbaI?kAhY&CnuqZNJ>AMN5AY{RG?Qf3*DzMwzX__D?s(@{@NC% z<;}HqcET`PD74@XDm)FdYP??sk58mF-N<++%|@> z=e2aQO=IMlYjbOLD{L1{YJM{?oFEu&i>X{?>&jpZ1?bk|C$WOcyw5g*(n|P}!_}K;Zy-v!4?|cBEx&h@NoE>r!CPvt>I1EbsV`*!+e!<*;++a zqp==Ht^{{gZLG^vlG|`0vgxIZt73hKe72?37}yK;L9g0LvCx3 z+e1VI|5IAST=ie2b)AWvu)pXhklRwEClt$@MNk>?j_}&GOGj*{c==rRQr&SIUkM{F z)DXN7p<%czhKttj1HQ1YoUrZXYOD^NcIFOw3n`5$ut_)*g!3MK2BniV5c!8cYCft2=a2##fZXX^~0<=@%9x3G`3 zISm+QrmeE}^N+Sim{$Iq%`LNS8s_WC0=D#T&D)>o9YRCDu^lmlNVPFxe`zNMRk?Eij zedvx%pYu$kbj4gNmy`i!^$S2WS)XdSPPUi|6eXF}Qmvx=hEtzh71E%L#xsMrU~o#J z%#M~NTAov>fi;Xz$P@mnMuTO=LT<{L6s06UZfYyrC_@5a9J-XG42E&2M-L^Au8T0? z=JZfv*)dw#L+QkhliE{>po={eH;h8~9?TDj_Ed&@PY2g-QL#+zsbHb~71j4r(2Z38 z84miSr6^r-#}#KQ7bYui(Rk-ex-dE|3a@hd1sH(5Rl`gfP z!tFKp8{PuLtL~>~we(lGDzv&k8rrA7l7#R4n^6N1nleBMG|J-^4R2`B0EMq~y`crS zg|^=c>0O~x^#B|l_SlFVUBkpF2fXEmKwK7(*ey8IUIXO#?7 zp`;AxC_j>G+ zXk?OtbHH&}{FV>%#jaEZE>;xGl@;9<#t%32rV5V zSSi3lJ6)M?c1e&soP}hsZ_)bBR9+O?S-oK!{A{E*ov2d0@v7IiYroG{wEn1U{VvFo zPqp2<6x{N2(4qs%WRufEuaEEx(3FFU+lRTd4qqtUMSp(Vg7-{hvvOO~oTH$tFI61J zV7YiyS%x!$`Nx#Q{}tMgLnqLR<4O=t!XV351G*QLolxep04?#P@)H-c;ipjAl>-V6 ziP*Sl{FJgQxOw$l((-UL{MOhbhg|j81N~_BX(bZ|jWef}h}+;fse;jTLqenUK#D)3 zDEb8wGnGCB;-;NZf^N$*33+aIfR=wo`O}AmXwTFuznO8Cd&+l8pef8k&)aMP+N$rs z@!rB}gYa04`+`z-lLBo}P}8&=PW2ZcrdMn12PJ{AR+RXo@+XLZATG811iG*Y9=BLK zcTu^*aB>Hn8mKk=tYCQw%KnP6x0*^F!H~(nDrv6&Ad2StP5Ff@V(c#{3z2AZQyciK zWv0Tka9=I?FJ&`Vh_2mGV&Fyoqr|}*^p6s#Yhxl+)P{yq!8cei7yP4iM%v0oOjjth z5yJ(G^hQ0y6vN|bdOldc4zvU%`N5rrMohtF%bALjmv>MxpKZDy-#B}8gQ+;x!PGFE zWxw?u&A%rIZGiAZx;)0>i)PL-sR=lPlx0=}5vmBrEbe~Ig~f^w4i}aUZ7u8fYhqw& z)B#cwphA|I9Xfy?i@hyA&qp;2?V6Xq+D8p-)1Jqme>j80;hT?_UU2-UiOGT}{aaZ5 zGC#+p=sv9)T+;#Pxg4P^{xRYf`QC~@Y4#%LXCAAU9psHnc z4-8fa`O+$jI?-~IVW|3KP#{%Ns9B4(s#t*Bt!3F%T-&%uXE_}DQYdqB1WxYCZpddv z^#k^Ts&;A`G)1uOr>W{*)E#VBi%hOAKrI9vw1g!$}zTc1)&Fj#RlP2pY-iVSVyuQ(WGZiR4L z*MbFxGX$K|iT2K}L32XX2qEPTc$_p9Bh0wOaI5$@ zoDjPe@}<;Jb(Vg&4h8CD84I8D;JtJ*ROO1E8iw}XOM}8xY@ne6ok6KXxQfGaVQOcC z26(Az0v@3X3s+@J-{wG1BE2+R?RA@wy#j-U~()C|(PN|C~V*fn3M~S;DY*!*6J)A zxN}9RGjZS!9yZ0J)S;FK0ml({!PbN!=8RTza8D#Z8jO`j>!a1~xDE0{v^oLD?9$u7 z8$!9UDt5`=aA8cfQIq(+k60B)Q`@Su*|6Iaagi_)M;&uYTxOiXWAUgnEk+%Iqj&W@ z%fT3R4Zr^pt4_l)J48K4o7<>vn%xdCqbTxGz+Y^qrr{n)kM@uaqp7|<*yvFjnSk7N zkK**Vv#si9SqStw8;qf>IE??yo9Q_8$?uX~jKk2+;`Mi8k5O$$6+^NOhGb?u&>u_b zo~HIBcTi)g;ciu7<2ZCEMRx!u<9V@h^lk^0pRT)^y||+qjT<9#I;vf$ysPTQwGn&| zq0aGWLPJMHJVCAmwLhE8@rlC;I)u7YRRXe2;YCK!g{i6^1$iL5rgALCTBhCXjMBT& z88sgD2u{$woe0Ep$#oZ6ojei*#mz-Cu4AMpfI#lM)IK;+mz#vdq~W-nQ*xJ@j01J` zcd27xbSmrx)N?wi3-Mq;R%f8<>8yHivJT%9aHtO6aB|-bmVAci@De6I33wHtD=hQ9 zqa&|%N^OVvB#m~LHNLZ&{2P5PW z>k1ysr`oP+f2!(=3Fig=y%+|h(cRPybow5(D=mpcJ5%pfqba$I8c(b41^41S9cLlb zu24pdiW5e0_^L?+_AeUL(RrdAJV9mM5xbCM9Y=NDF;y?($V8Dl3H*c;c1h|4Qh4## zlYsCNs_2Qtv>uq@mfrlv>vf&MWA2Ws8JAad>YeMM#^MGGpkt_WPe`nSn>cxJmj&@- zaj*@w;&NU$tkkPMb_J2#100dLA4?6-G93EWsZhjwM#G6Wz(!EmJM{A4;9o52fNNOFwlu9u#2x(ULVB zNne`PAAR&To#}7Xts`tnp!R0#Xwv}j$$J!ezdDA!Px<$w zbqkT7%I{alS=NKUxh%C)A-}rhc>u%f16uR|u-HHq52%A#IkAB%PUcc=DspZfh_SJe zE)PV?hm?}4zKkm?NSTW(E9ryOfmqh89t3cW?tTzT!)B^@5PYS8t~di+tX0gb}n-QDLP#pN}V4BatqUe$PTJc2l=W z!iUutao+@z562OQtJ%0{A7@?-J8s6?eDjNZaTDm*}6#0_! zN20lhjdGG7QCGnBq(e14f_^$m^`q1=2J1CsgT>O~z-+54YHjwFv=dS4#ho_>e1-oGn_job34eR06%NcV%4KiF}Y>0 zj)KP^wf>IiZ)n{ZKz~cFO!U?{TAc~;c%BA5hC$VkiNe1#@XE+SgTJRsS%}Z13_11Vsv@JaAL$W7I`nyg0W!nOH@4$3{=w-ZS{-;7yWD?pEnL& z@e5BJNU4vZyK2VakNcF%jc3dBESaZVovCCz$n&c)wyVagd9aUcilCt||5#tV&tML~@>{RJDtMD<~Q&E#?5CO-vf zojpm-FH8f$iKZ4mc+k@Fqs3Rm~)uXR~>}F)2Aq$ z2gn7Z)lF6BTdYtM4IQCkI^s%3f{O~KLA==L@-)a5g~MW1oC8E)n9D&Q;lZR_bk4Y` zoWwbNTFQlN#qESc85>fs}GKi?q zM8H$#RLIs@xvIN(1}2BixuE-i8R(QCDx9GXHw9a%)tjz>%BO%L&TD5qt!~AFH+&|P znJ^mtj2fZMnhDmzofE`Cc+P@sZN(GfX!g&pAS__<{UVmGgPuV0^=B}kBWc*P>R_QY zDB&!+T!%AC&q7g(q7KigJ8+lz(sLMrZ4CIb+3G|r`t-b2Z{xXD&m2@1Lv!W;G?sci z5B6+F)z716+Ecr^>SR-#m42QW9zx}F)%jSEh37-{NXx@)>Nf|2(mf0vxhfAjOh>B7 zgRD)U`aCqn!vS|-!E`1c^7AfAd;!_qFF-VP;@_RHYP#_PsG9d3-#2;z41M>l2$?HP z_nA~NX?juZe6TQJj7@@vK zsGlApc>#Jh?`VKu@dAwFScHn#`I&LgL@(|E186e`s#yp|^ThFs_Y-i#BkV;r)|6`H zDsy`(!2=x7d4Uk7oExq*(}Py(_<&ys)qDYTOK!OQpz-D|MprvqgRg3C@RQ;TG1$^* z&_XD1=|)x@)Q4$sA(VlKc>T~T7DCPqLF@5U9KY5)l+qWez4RshF#g$Jco>Peeb`$F zTwc-=SalVgRJ9#1!g1;kr`kp8T44lWT2ghfAJnMbFj8im3Ba?WFF^?%N$JnyrdfFf zl>O5KTj8q6QJ6%}y@Ubt2;F!|jS)ua;?Mr%D@Rs+qZN3GQJ zx(N?1B({+$uShM&gqgTZpEq5rAcCrH;7O|TW$F^#JV}2O>{InB=$yG+y$UV*wulU> ztH+`&=L#;ptePOox_r-~%f;YF+^Hq?Nqw2DP?jScitDh}cu$hlgV48|im9RzD={5m zdASmEf{q8?P<;g#P@J!-%eWryMc~{`7!63`N;hu*u2wq*j6-Af1tYgP;D^(2yp>*W z5L!`GM)8kb5I#$M&l)p(0RAD78|)9%cGHsX}dNE6P@z5~U8qDwL0R%?gWq8RG@ zChEKRF1jl1O{lOz>(nLwPySyez{q>3RTyPzkeg0Fu(scOYO*i`;5a4saRj*TJs|!R zRlEnxmhkVV^>51vG?~xhGkGu+iv=B`jzc_SeAj#&!SCJ}@oP=|?oH(TP{(N2dqA+R zw6#pj@MTH$mh?PbE<;IkjU4XvXut&ynZ&=$@8hfCGu-lUKMbQq_IfqQ^}?Nv(w47R zeSQ4r-5IZwt1yYbPgVv))9G@k=D5mU0rpwIJ#6z=VA%Z2_%7q$STgYVg5G$;rJ(}U zT}W&rxOovJZbY`1yvZ9m*(yNggBu|cmKd?hhY&dnEAXf85i~OOLrnL(I8Xr+us%S^ zc#CeR0%5Y#W*GSjjL3I~w^E8f!r)#_>PKpvZlcGbJR1yuX*?PSh(A)JZhK3s5GPmF z7ll{Q<}j+5;KrS>O<1R1*ofJ1)$4j5@OKo&et261Ok)@W)G!j7QQaoYK$X;?61o9y z&l`gxw-VZJakG%uQjpdXTf;S#=w@s-RKmu=Pl9suFSl{Tz;P3L7r51$s-ZxDxwe3J zQa6K$z<;wE<4-^~86fsfERZ5fQb;Oos7WsyTEz1&{ahWcg9cK)2-$!AbF~c7>%LIm z@J3hs0oKa-9%@gT3Hw@MpW^v~k{YP&m2|mAul$)>Z*_sxf!T50v{s$y&CGle&iD!} zUEawaMro(iw)FXz>J!M^?XWsfhZ2mMkt>KAy5d4n-c?LpRfnM?p(%&eQSfrBV7|{j zqIUJ>NS9G=)e#*F*HLwzH#%|?#AMk~HNzW5^)R8fwBwZ0F&(z_m_8M#$DtB|?8m|8 zoY@4b7>vu^o)dbVQ%-Oa(e4w_zl>DZIfIHEqbVni)RWM6amVN@-klmdW$vcFV0hPki}|&Z zHr44Md_tjv^-%RM9>s`9e7(BEo2LnPC=1688e%T|25M|2{r-*mKD^Rzjb@+IxozJ$ zy~ys&r2VLef`8H*_tZ~1 zRSx~6GvMfpdgPXidcM0a>7l|)I??@qR(B%%$)EMeyMNJZZ_}WT(OaXE>l$AhG=SGJ zW)Kap-DN06pd-8{pf~uWe;Ilo&ItVKWnoMNZ~MdG`KumX`s+>TibT6_@o!j%p}&69 z@m%?vUSj=kYHx3e^~vD=q$^(5!K0cdAYsa{=%Zou?>ZSOeuvUwoKj~;FepInXu9}2 z##ZKWNJ8hI&^9V*{U6@Ww2{uGX@BY!7yhYN{KKDm>(^h^8>U{<3(mUcMMI(7Za`z( zHN6Fwu6bLakjvZNAX*ZOyAj!c>5^~GU*4AE7(la@hyQ&upSR^fwCr!4pzHs>nPc^D z&?s|$!wL#gzW8*l@=7JzUy>Ijc-#3HPc&NO1Pf)fOfNbv!g zc8NE2d99rfpLWbXP~WYEWNy)qQhwoLWWGZwDjA7wY-V4hCx#%gHx+iY_o9-05DuT3 z?2jOGxR3occw2nzd;pC!+h5k}3Bc`dtoyv8>~2A?XsKZTQ&07$!q1VqS+w(hI3wD* zESw_Qxd7QG+4+bcB-^)QxLPds?o6*A_MsMiVCId)nA`=WAm=q4))?)Mrm8HgQ%kJ& z3&<4-F|Mt$*>ijlV6Q=@yB+p&eAhZq4)(&GdR42PcCKeyTy`#!3te`DTg=qstlEo` zKUbrR|Ik^au%!-oqos~hzOQ{TFT~Hzhw2tTj<4qLZ|}qjo<1a?zg7@{C!}Io*J9ZzA|>Ab4OYB@pnGMTN?!Xxe9;{K?{qV02g!W@_Xn0*XX zf%?Z#%NyQh##l@YCEo9Lt)P932!>9?{9*S!hT!a3L9%vmtbH~!m0}(97LLznj<+YF zl-yx_Q*}JZ{U#k94}{;+)y<;JRx&r`O}0l-W-+cvr9KX7!Jv0zf;|RiJa`dw`T?xC zM@+QG!=P6&$sP)WUg<=8e;D-i(0h7_q93>8b}WB#7AMts@_Id)=1;W4!Z#6u-Tf+m zIq(U)jMa1S6ZSFs6R37_oy9&x-E^pCB~RFmcTsVbAiND;ju?W=)D6?{>f{DPIj-ZG z%Z=~r_$Kot6rTB}YPO_+s$3)8h-Z^9lT73ZRrz*>zhlGoYOYao%iv8N8#DK0`#h7r zXUKQj+fr>yhp*2?kD z-9FvkMPKDaQ@+&?+f;U3Ds(<+-wgBOz9;Q`!h1uyX_`%c5d zoHjL5Daz>xz3gGE_41a7$`t*yeJD(lIu<4CuvSlf){G<8Purc0uIBJ2&O{S;c&RfJ zXjV~0KDr2RsxHGh<+$|SB1Fprt zaPYyM^Kw6*AkFg(XM^2Z{j+wP5A2v&Y=)BjJlJQC{%r{W#rR@rFAr)kX6l5k*gzHtE}U9Z@dt5w1(} zCm?lwlG5knVRfA0LpBg>&U|}s_JvkG-~KIs!SU@y5EiwR^%BPCm)uLx!WP@>1XiQn zD6sGG0SNpE8n7HRTd}YucF_y%$<&a77ci^t!J@ih8D5?kvD`k}$8;DA;}TPV>4?`q z>h+I#{o{rYJLsU5z-0rCUul1iy{^@-wD&UO5@+P=_TGN5i*kzST z{-y;LG}t|`t@3)+ONef&_h;==gFQ}wNmXa8svWR!lz)OnT-piPjMDzFcQ!RZTla$^ zU-E~&4~(q0!C?=PIqAEC$dhd?l*Kfo&q?tknB4AANyosS~{w%pqwGErc<*^yxS zOSd!Kxit$jFN`sG?jsjlkQdC3J~+pQZp5^_9X6Cy!Qn=JmKBLtOaw;(zFnf@3z&d) zmb!Az4@cZMxaO7|SA9&4RxQNl2r$9uo2WWwVsv26z$6`yvKmwe&I;1yB1foh9>WQ@ zrcWQ^^G8@&Ag!C;mX51TfIq(>!wmQr)*+BZAYX_*`UV&h_4M=Gq{DXSe(#cll+SiGxW24}!BiYp#54v!Gr7A0}S zV!VE=*KeoQ#yiINu=ZM_$ML7c;y4@Qz*tuY?#9OJ0hmAW08iClA(-tw4mTx_z(}m= z=Gcq_NgS9;?se?4bVPxAcTnyAmNAsHG!U;=c6VH7FpG1jq6W7arg1%khre}E)5CEZ z*FGVHdO7xcyDKuwCsbRJj9~}!xq--i4$Ne@DA&iaQ!;h3(I@wd-v4&fnF>?E;dgT{ zl)}#P=krq?vgsZhJ%7J{$UB1^CNzr;c8oRAM?D;PV&kEfvNk{6u}p+W&##4Pr|xK| zpO!qrG24c5Uf&mo^=igCvhmz#k8uv%Z0V-sP`n3MJ3Nm&R`}qsijGv>BuA16GrQiH zoQIueUS5s^8zni8Xyd!T&>jS7LAi+-3w1e;G?lYR&`lQTk&EGyq#ez5j8$Ni@Af=c zw~IbC*5E`*T*Rc|VMR{b1rEPSc5Y}E5iKnU*JJN$6sCEtv~a(+Ss+>0H3f*-vD zkuhFGGAU~#FmQi|S96k1U>9V~VuurFUO-n|gIY&B58ot1p&7G|mKEPH_TG;WR12@fThs-o$fs6{Z2yp`Yd! za`exX)6v+6EO5w{TrURG>2iUCKbzW=3;SDzjuANZ!dVy`o9cQBpv^h(X<|hVU(-w* zeN}*G)!$u)c@RYZf3&@OTvbIE@ZULtLV{=Sv-dfGfP!FP-XJYCB_T64HKEMA1*v7J zh21au1l`oqf>5UN5|n187L>UywIJ5=tXZ=LY2qQzdFE{=rN+*M)N0s69$RnK{6|$T42%*uR>rWQ!iL3S%R+@5 z^Iyh7pyoSvriz7>KZijJ>E~e3LXe_{ErOfeeSD6Tf8>t>OObtEW`p;_Z~e$V<(_mj z)fz#jmwQB09hy?C&dcG_a|Ew&>W*J8G}Vpeo*rnbNz=Woum_iU^=ykW`0|#gI@c&q zJ2%?v1&?^H#D|oIknt!iXuisP6c)5V0&pUg{iKHVVXl7ni6=hpp_8J^c$dLl7{Kl9U+HSb67nxPDPg(JueK}> zf|}6(zz5BvCK08?j9P5!I{f~wTLc3 zCiY{&_t0dn2)+xylx9{6?x(1P$2>igA3rJY6DQ^6ijBuSea#iYXt=Jf;z_mXG0!xX z&bs}D(TQP^A+qw6%B%47WgV@-xVnOoc&3RE*yWX;Ld;}lR(b}oqz(-~=N>8<@-;I1 z5xrO7Lg_WASJLA^<5`X4vUQ2~xyQj2E)kSTUiCPVS``PgJngZbF`uA73}--6RrmyT zzMx8Q(4Gw40-Nz#;WYqQ?I9q8>lQhsL^uc4xEN!)%?sqZ!`^}XYzs*D4m zXiaAqi}lr>$?nKH(gom?HLaNA|@> zqU(DhYnY(AQT)}dgCcR<=`Qe~YCYsN!tvaVRnGzkZuNtzc0km_s?lNAH3-;(M0nPE zQZ*{qOMu`3zC-p~LU|U7@JrzH zum9!qZ~C+O`^lfxa0*q^U-taw{J zX7QF&10WkZqKiB7il;X#IM*hIJyI2KU@n!2oL2ZM$a1PgpbmP~ld6g~0p+zDkn#(U z*|wHYB5KGRC4~)gqfvi%iP$66fT?Yq=voi^*&Y@5n&&ahda5^g;v+@rDd02ptMl7y zp0zD~UgSQJ*X3gfBP>o{K?a%GbAuc*qVbf5)>Wysgfr6&3aGFmvJ^*EUZpcX)!1uN)s9BkcC`)8PDt zAeI{ZE>xzS+Mx_g9^Pe2wP$11$GbmCTBl9^~S!%~ni#zhZ@XVF+`s_u*$x^j@ zL98ri&tA_vqIlU`lgLisR|q_*YKNQczubL1A91$t^K2#;&N4jh@qgh|AMo5StmDPKY652IY;P){)!y*Gn6pP zDfk(%1>*WTHNPOCv+$ZZ*0RcfXCmmdY{=&&q_a)rN!O#8uBwN}VRva}wxzv)d$OAiv#L2_pQFy17wc8Ib?AF5 zj=@~O%xk)vZPo5$p0}E%T~uSt!T>D*ewWc3+q24T2J5qIFGlZ+P|t338C?Lz-m?>9 z%H2i+R%wZD;{~kJ$nzfkt88J!vqUF=iad_Gzf0gb`)^K!cMUwF4l>HKFrZ2ZGlsdB zhL`%n&=D>M-MW8JHwgT-o79QLu$;E)MUm>TI?Gj)oh(BlXzR{qxyr z6x1K(G9G#$N)@&=#z_C(ZfTs}L55Kb5M<^Em_m7uzbn+ueq~$&fzN1V6tTln-O8BO z!t4eC5R%lLkV2p>JD&8%JA+#r`&)>Xz+=Q{EJE*dWfBm2umd}64_Q&=1Gp?|zQ@RS z0S#AM!zwq8u#TC*(#{~1c8EGxN)>dQ%1`3hX)}#@z2m^!DOWAZF9!k(&%#Y``I!! zppU4wjnN!-iu4iLOLg@b-6?gV&$x_WlaFtwE1zFS4)hxzP=9d@K7TV}j9l=V=b?hv zIxc?@vfTby;})_=>pF^3K_D)|RH$dtTlqWQ)XL?!{?1Lo%%v)hLN%mBaUa*#7*EmF zZH>Ms26}pgtI{;ceo-cal^bu2yhDZ;h-&sLpp*gYO$2Swpq2MNyi1zU_p^DC#)aPd z^4?rA){l456NJ8J@h&2H==~htwN~tuQ@ZI2`xBu(OE*iD9gGu6CzLS9ysZOOB}GJ@AN=G|nY>0fZ{1*LPl7Q(h9|il1Ni?b$Z2m(`$tM5 z<5hZ+k$&PAO>{JUr>O$oA*wcsCS4G0(wVB5CMC<4P``%-KgmW-D2{VP$>h2)_^FTD zA-T?OmLfO!sc*A5%qb<;MZr(7DXNY>r&)@TYH70Z6Q_wvJCJZxFd>`PQuEig{{Giu0}m3m1Z{sCsFA9yBnQdmpZe%Q&RY4RD&buTU$~^rcvVh2W0bA z^%+KhyK^`_o*mEKXFwjAD?NzT^GsFxl2eGOJ|G7Ydl*qo=3jcMDRWAK(2L5xaqS6e z`^H&LRSzRWy0N#X(L)Os0HDd6gD6)5IlG=|OzRZl3qSKRvqU`N$^g@Ld*N53KNe$^^ ztU`13b06pn+pA|A<2A%=atO*!X%cgd@)~$$zRMGKLV_#cd`9;ZqOO!Y9Dh1LDyl5^ z0rtrI8v9-5RNB;Bi*%JUFw5BGQiJ!@u&pojEB*0Vf z0OMm9W}gAcB-1oh#cN2(tA}&N?e2kwTri8&$r(-jO_!f<+z@#SHOlxTIkV4)&jdHc zGl#da!X57EL{Xr< zsLaQNrwE->d7s0o>PI2#6bD3od$e)4c=Bdf2phGr#%`2$^Tru{P2ol%JeQW=C94?} z5Xo5VU{X5X_*D-mH8#m3oFATGaLLdSC;2j?v)d=~Nh`h!os_8}Fgc7&SL#m@e5|-HCIY$&XlR(FNw0QHXajNcAe3KYwZ9q zQPYqkGE@P9FN5w$%VkoBnmJiLA}J=TP1B5C;gd<>Qps0`K_A}(S&Zq>i(r9sryJ`j zDQAXGK4k`y26EsG<6=!!!?<~@B}(lt;!tT_gWPbhnt2UltGjwTyZDLM8jAx(^};g5 zn9rBlg+}*a=A64DEMi_S1Y2}{y;SNEhLvS-`V-p8K3mvneJ{053~NSwf10!>g`lvRe8dqb%}%-UE&5bB9Kjy{++=F!c^& zt;;pvNi3#_P<17D(x=I4`<=$1$OTQ=67OQvCa9ddj2MBA7Ded)#zyAx5c5_Zl~7K*I5E!}W6&?`?w1t(@WP-PYdGbB`WMo1j zYx8)?Qxc^v-4liqquhu(vy?7}fY*G+>M2QOp&^!x50OwpE-EMoRTpwGv+*jX)MyZf zVndzyFpbCF=V2q>tAa@%4u+3J1rD2N?dQi2Gs2H5^AXZ7R>cx5QH=yD;bH91r#@=T z4_`*cD3!MaA?C4Q8JL4rK-K##G18Ush>@g<78|#OKi-rO$0|nPP|5P+DY5V>c+}{w ze)}s18n6UX_+(Rt$d$p8pK6x=X=ztyRkD<+^NiZG)EI$kI(iuxgVV5OaJDr%P{vZu zlkZzbPo4|JR|SIVK=6DZ)zoE1s>-N9PFd^F`uK2k&9V$FcjCpeTpr6xMu(M^l!QT- zwy!YWkzHEn(UrzBS>Q8eF=gqF>D$y*h7pRWcs2!wunOEeqHbIb3AV=6x`Q zM5wy$7B@o-7VqMY(ItwTxc6)}a4REx8aN*31FCV0(f?nfb6z(F{7dwIN&WwGba!Xu zn?eoH^S=l6&zQ()W^Xm_M%mxQ<(>MiECw-zW0;;m!LNf2fncK!)bbVJVa+x&H@t1I z3-|;ZN)?k)PUgOAEKw0#17Gh}Tece9GO^W2aJIZ>{N_gAFKPv+?tNpS4+7%)9v#E{ zwrD0Y&SwTB)uB-+*>CjZ)9d?<5t`_?RJFfA7P=fj6sc2Z9xz4=WqRO%(JoMcTyBaB zrjHL8S|{?y0i!J+eBTAqUGv>Z>DGT|bV+PZ8idry;Rc!Uf;+lZY2mecx)fLAwV@_F zD$Ms9?;;IG@N@AKg0NXtcLD#Ve{UH7pio=Xg71wqjYyqU?bH_7*nDrCC;B7U2>yG1 zFp_xA{F#|u_=7P$NLf|G4sCiverlkGegybEw>+ z5>@`wiSMf9Cu2#dP0ib9{45=G$k@v@M3xUd0GP-`llTdoh1Uu&B~DmcD2~Ub=a3wA zRVYqX{{jWRQ|kO#vQ*_hqXG8Mx?w%7_U_C%B=ZA88~YNQ8g!rqr# zV&EeOXQv-EVg(iNJ!+gL;j>4LwwXy#1zBfFuLMQjp_kILljFCA;+@}*BBemllK-Yl z+ttj!jl06%&b zcF1G)C+KRJDJKeXR~hEee@vSlfhncki&veS3PIV=B5uE7b_tf6v%xLv;jX6n1zTz| z+D?Yo#3wp3tZiOP8`s#TA}DBUibPu+r>n1x0~`l^=7fL$(%?6z@?~s{nI?H+0(oLg z5t9pI&1pn#k2N3sx6C@pKkMq!$c|m%S?wdr{dj@s8E=l%l2WuP7>7keLZ^-q&gyt7 zMGW*MnmDFCUF~US#%QI$sbxC`q70}sA|eHM?qrZ#DGs=?M1524Pit>RgqLy-H!)%E-r+VlG-vHT`t6kX_4AY*=|`b0NEydKp>O*_3^@O`U<`5%pJR z^ND|~taiyj->-Ak(~FE$nP^M5kjM`t38!8}LV<+t6@^DSjCP?dj#?5PA=DO!JkC(bMdQsjYMX zS%d>SJKID#MLo?A!?oF*mH<`3pK;hrq*1}@+3^uh#n~p-{{kOb+a_~II0jx-9y9e{ zaXzb`nWjHjD92)9B)xnQ<-1^-bNiXI!ev;!s`9(o6xAh*rpY_Z?n}_4A`AHKRco?9 z2#MxQ)JG_W^F8d{)n}P@w5X0;v_SM>sIRk3nG?QqOwkdYc@Btwx*B_q*9R~ z!(`UH0}V|Y3g!Ip3^P_634Y@=o^Q5yN6S#kNT0`#;XJgU00WY)8oRWz)Io{y;v-P)?;9X8iCcHmaS{1Is7>&KasgI_9N=47e%rdl}Ov~?s~keB#D(D8H}7IL}C z9_kd-3`HZtv5dUX6k%N&=p;=r`^mUXyi^m>zb=LD9C2vU?K<{yX{qGjC9XF_zf>~G z6f5}JNg8{P2Q0rQQrU=g|YW`zT z%T`VCJ)1f2;*O9i5NUpeIR+zw(mgyMtuU*wA0X$o7=MSNa5(%pQzuGQK29akPUI6N zP9oc=KFgVr_`6$SqFMeUnf2&$GePaEfR@*+!0$-?a++<*_wG0Y$yq^WOuMBXK96+U z(W={N(cGf@BooRf-|;H+Bq-sR=l%f?RxyG2qMn$K|t3FRLVhQTjr|3(fD*fJ!DSz4=hJirvFSp^wp>-*4Z`pZ`D8i*XO!PfxZS!?JbH_S?>_OGJPb!&iBy2^YO z*`kvKDXQjKL@cCxc`kVlKQy^LIa!FUbTFbH8?oj~Le9j0S<(x@uqF`h8?5cRdOl2EVH#K{$nHq5I)w?O;7R;Pq zT5E2`xLLzseHAdMc+tGU-8WiY+DArrojKjrF90n(d102gjwWZR9qY`Y7%kJWL0BnE z|I2&81?M{ENHJ0l0knKQt;`A3H+4P0K3CEPy?PC3_I#c^_je6cc`w0=&X+!}#M_=8 zrI1%SXfdw4uuP^_F420~EWtb(q>jM~$K2w&An=^M5gIZy@O)$=h%iiLZi4a-mjL)~ zBI-g_@CqZ=aA|m0`76AS5G+TudxgH`%D3BbFtUdvxE1;96@<@=)vd2m=ipcA!bo`@ z%}&^kR~gAsfvkgTkiGKBuQt}0cKKjXVQvk;AEVaPFmc8zUoF#UoElgQg&nWv)q>U& z)bF+Cm8vHhRK#mQzUVauZj6+)@HJ$+%hd0$!4~q>jLkHmKrPw~Xf9V@Z$^-wq-JlS z5tG%Ymb$!#E2PE3Lma(8u{(5kO=)Q>aScrkeCBIAeW=oIX!?_)w zSBeGjyA138*BR0xbx$1$ij{8%kU+ZKZm3B1asAp4Db+4kuFs&-RUeZp_cQ8d1upy~Y7Y@xK0{z%CNS%)-uevmtlPtXM?W!> z^enI14T4oPrN0|@btJvG{4+D5{BtlX8`oXpYKtR(pMus6p8_8ayME3@^3e^e<@E?!9osXVus*`TU%k zw=V!k4%U5X_QuZE^%Vn9t=4=M0^#%WJk9ljirWWnu9X}c(0C5~8diaq?ys2`j{55x zv%9+C8$hyN?L7d6DEyW-?=OtbQ2oAvdcPzoMx$>FeN0tz_tBV!10<{ZmN~vL@Tozb zHwB(E_5;yZ0uV|#Kn-1rrDi|C!_HQK&8IOa-zYgvEja+>Mt%$XD3OvQzTGlsRf6D{C2hHFfe&nO=+OS_jD!YX%>2eMiSMjM;aNk z9cphQ0DfN$`O$nq3}%J$rte1^obf%_kvm&lugs2~z?!uBC-biGoy>S#j=hKT=3z&m z&zR2sOhYHC;XlLScd6|^GmI0}??1zq@oo1DGP4kuPvo&X>&xO_`0$x}QG(s_#)|KB z+GI@cfIESO)SG`1j`}lxHG8`EM61t>qfZm3cfXpQ!@rQK%kpaB-Z;?;tLOE&Pc8S} zX!ZA<(dW3og!bJPeHN>d%-{B~_Gvo1mcjz~O_Kke$A^z@uGkXLaZ0!#u zI3Qo(AR|OI8uYM**7bLM)_teUKY;1?s^AYO!9i902LcDH40-z@@OC)x))07W47~jq zc>77esr7#_^i6KIKIToIBm5VuM6!*0e#|v9jzDTc#Hkew(t6BG9 z3|A59UC(l8_9iO^Ta=lndQ)7{CzxC)v$faqNz}huTVPkx+S^+jZYBx{xae41s6=_i z^rs-2Gq8nG-Uyvvl#`)ViHRkR2&=kwYUZtBmaK!j z4fS21axZX2>AfcmYuYjhb$_SeWzWlSv&{5*cS*uWE$;;yqFL0~L6ve>bh+(i)va>I z(AGNJ`x|}Q>eHi}<=0@i(eE8EdEfVYPv_%bey><%onS3oBoVRRzIsg_>%B>XmP2`S zDbu*HE$XcSmJuxod>lBgIB!~T2zERMEv$G6j#u$ra+nk{F3x+l)<}_sb~Zi%kaK@v z;MT`^hXqS_#dv$E?6!K~^4faE&gWJMboYA^G>*rcdP7_9+yDSDzBtRr(aLx)G#;zq z1h42`iqE8tOA>(r228ia#yExTym(&EQct(nY(xElMdbid@1cteHkgP>Qz)b0|608{^jb@W(QSz3JT3yyxjwr2?iDRXc)x z{f2yWaV5{7^vE7=iOqEFY2Fl_DODx^&>n>RISv;TX3Kzab|VWrd1ZHIUMFvVf~}pr8)(x#r+Y`cSRU``th<-oMGpkMN2e+9V)s9cz2B@eRbHCjT( z8oGHaD1{;gLb{PP-M#B|mm;7cphn>*31QB|8D4Hi4D?AgoWqUC88<^6OFZb>i_Y+d zX{)l(=F2DmCeLF0r>O~WIm4TpDAXgA<`TZi{(NX7hmEN-^o+o2+;aN$@QT5jGoz=M z1@aLGMB)xG3>$mPSYhUf>yoLxz5R4M6B#c|wrhHOKjxdOFcxdk0}Ro|K3+M*y0wpY zD1q;6jdByu_8tbMoD2JUy;5>PKWe3>N3y)}ZVf?E05N;FrL(ck-~-h?=X?RO|- zRW`s8`oNa^sa(`rl;gDn)_){u2VqFxnZyla1H22RxtT9}EwKg-&>v^!`QD+esB_bB z?-K&df)P;oHcssb@0%`7YAIK%J|zrLvZZ<6Riw;$6F3lj=WXxIy2v|S*aWiy7i=Xs zdP&N+LkQ@qbp zYt|Ls&UEssE4&W^1Lyat-m-9_^NN|971wyjNZd8v!vcT%Fbr8f9deAPQkYnIZh-F94l_8@(56%o7?fNt!4in1*YUJRr3HMo11Qb5j6w zZlV<>*I}+b{U+~ZZ9?$=&E9h9Q=spPzH_qmR&RsL-=wu~Rx+rw?so5Y41iO4hxa+@ z1wFfx*O!XDo>shWovUYQV<3o|$5_Me=0T@C&YpQ*6kLXiz8@HwidRVQ{oW;{ICQ`F zW{u9YHHSkK6|b;~rkQHeCd}I2dcfk~*nCI_RkKAVnV6XJMc$qo??jg^Qjp-P2)bTX(8_LK{yFp`;~MT1Dp~}i zquv$e-uI-(H$F`BF~odW!*u7vnr8VP(fqy7Bi;x3w)GM3#RQ3udaos@epCkkQO!T((pDn0JHB?%9uf+v{3GMWZbaB4+jD-X6ih6xvk&gk}f~ zmlY{i;~ION%qP5?rQYNx89sZ3w@Rv5p+__r{Ix=Zlmu_;(#};oEr*6(JGa6@rPv;2BNR z2bw|s^?@)x=gbei<3kQYnt<&9?A=1`7knlaI8T2DuV^m3{l@k4^Y?gHx7HQ?WA3Zr z2f*17194y=9F$~SfAGFaU>??NMfik*PeiG0Td@-;JQs7j+{4})Nzvf_OoToTpR8;2 z;%fqz61b>vRv+%Y15?Uf1t0BK=})xZ*`n?nci#mCRlG!#U}}t@F!QI71NS!fVdQEF|nGxy_I4; z%yU7ibvr5cq*^1y6_4tcZgr!L6Vt6wUM{@50thK;ty@wzNPf@=sZv$Yzf+jP;vQjOU+ii6AuNYzscs zOcFhKwxvz%XCev|deC}i_qEoN0=dLe5&iVXf&HuikqhB)6JP>3JinjSTTiD%mA40a zTt5z*lZvB2ye@;Pi&{d_BeJXyDVB9@jB_N*S}v2f`UQAg-S6NvVVUD#{GYMG{C9BGG zjEA$&wM5dNc&>Fb!OnB7z69m~YqV~8jw-&6L`5v4*t97fU_k-Zjscc1uAK9%9t3)Z z%stO~i)X4Qfm1q=Qg~$zgN5q(R$$H1QWYrZNXi7?h@kadR^A>Ar(X1f%p zevnn=(h)7V6#=5UdWf}!bdVEi7UjjLEf;8*d~$&`iKwihRy@Jjp#lbV>riVn0dn#n zL9VvLtREyib+{E+)rmxn{Q5}?7)3b_@d}4qt4W`Dp>=zp*0Pz0I1+N9)kT^wgQAX% zph+;IXT>%_tiWn=b(3_rAI{T=urp7i{a<-B32CX|Vrv>u*nTn7G$tIIn<7pcAtYlL*yJWp%8IV#0jC3r#m?} zSYNrq(`g%itHN0e7v69xB;_XNez4u0{_pKh=k91EPL=cl2VU!MvDP+k?CM*sfXYhb z)eb7}j(Ds5Ha*88Z?ig|&<%_xXTmwOk!Z310(83F8rr;j*c?h%|3}Xh zJ!|hI{KrZUED+^%T1OPgu_ILW&p6tsD1vZsM!ARyNj<;cX{8V(-er{$RNrOYrTfrI z6?<@*SMdX+3`JT8Iy#8;nu?=2*>CZ}DYC3V(0&k=Y98SUpL!VverolR4INbi4K&Ayw-W z*?gT#7cd8zONFO9zt4q<3aIX*Ipn(Perpb|jrUtG&_QR#16Dvd)GN9))Xcef>f0#ZTQLaberlL{c+PrJn{x=@A^4Ywm zHZjPPN*{V4qNQYE-o5>(bykQ<4Q+>Vyb}AKjKx-6Gs~>J-%$D_EP*T@QA3tk@milM zHmD-aGJ1Q$QuwlH377^$SYpZY=3jtrg$ITuZ>gpj3zk~f%FO?JspUUg%tb`z4zV^_ zV9K9NqUM7t>BP;Yh;zXnT(~TlU*i8;eko3B57pBw|FUJ)Su{VSk&AE|mZ88hoAd&~ znzB@Q1-PNrC~0bUgeLThlic9=pOy*CaPj?ahW<7p|~Mr1ejNdU#@cQcobQLa%$0k!?0&JSVQS z0!x9es`e)#{wsynJJl<#zA}-Ehj9!s>=`Rol0IYoN`OBCOQo-}ZsECdmF{fqDq+V? z+-i&CpdbdZK}B)#vyk7@)m1M*N2{Idb0ul7`SJoEE^JMBy|mqWpOnAN*$@ZLWCUiq)gR0BYN%<4fO}4i)cz z-Wp8W%oiX^$nH%|8bl;Am{1PAvRSK}qZO!0YxSsSuGI*<_fxd3MQb$_9$Bk1>{zSi zk%AYQ*v5;(Ru#{iL;dKz4iPUX;WezYWR*%&1`xdHSnYLZx+>R~sTMJZ90plX#HDuh zGEkSUw|WP(u&1EOV~tewvUQMxXKb)mh0wRlM(YN$R&KODBPy^3B5&>0)WhNFs(yo& zTK0)Ky9IDwP+ zMnGgLe$$dOQqH4qTIaYlLCIOs&bdZrRyJKK~wXN)gWkC{jN+|C+|H53`-iwA=kHTGa{U-I_qws z?PtDktrUR*-xRo)_!=T!aeH#ux(`89$$kJl&)q3F;Y{2KlysG8YR6iPL63f91-1z; zP?gVM>{`?+KB~ME_A0xqbf;n$ONdYjQ$Mj}5vfb-_bIu=eh?ecix3nmKDBJEmdvB` zDJo|gi;%icS=KI^95h~tEFE+w?q_bq0HaxnDQs_9a!_7>{xtZjiIJK^_n(} zt=ChT{>PU!TpFc@?bYol*sH&?yOpBXo}GiuAvonKeobekahD=8i<Y6&BE{a-W|3djfCKU+Xnd@u^%rn*X)#q28LS``Q{wVxBG4 z`x_l!`i<3D(<8mDNM~dj7T}0GzOnAo=fXofinsAe*q)q{(MbfLJRhG5#oy}1b>eW(nQrUFxgw<*6y7t^= zaR7EAlqX$rS8p0y1_4RzfbRd^1J+NJp;z_$ztgbI`#!)J4{GsF^OSxEHKo*2z~qD0 zd|~uI9J1P~s6$qL@a5cQ+M3~qSh=#*Cgjn~j={&-;b8N+mQ@~%FUw`8W$cjEdRukV*bTWBI0+P@XYmi3wAtV#3Cz6b4#AFXXkhPH{x>?;-!EGJr*w5B( zC{Wj50J#+OYw&Zoz~`!8g9}343-)k-wI)ll-}Lli(ro69Af~LshhpIAcnp3TP-jp7 z-HJG2t1sg`R0zfb7R#&K0Im94_1<3fpVkI7w+_-;@l#BMnt#-qs=J&+dz;$~QgO z@EE8(P|M2;?Yl8P6m{B*6?RQaED+JrU+)tEPJkFva0d3Kaz^@M)!ZF7cv(X%c5s_2R+q~f1pIz?ri0&BS3AK@D8WJcLB zEfR+yh=t6e|9OznoZkVz3(jnhy}7090w>3BTQ2v|Hi7#FrpMS3+QUtTZb0#AE(^=Y z(il4)%SQ>^7q(Haq<8F~s#o2e6Bd9jy>O|v+GrX<6!R^is=BU4k z`P|?~jnw5P#&B?=y-;QQ?I>q|qTN#zl#P?oR%RsI{oEY|H1Y@9H&K6?XQFTtoRsp9 zIHf7}6QWT(v!mVG<+{kpIn4%dN@6H;>KS$oehzpHN&|?Q%;#Qq1w?wx?rmP6hu_wXJ=eVeDfkgq=Ey9tpuakf|Oh#lx6=jxBCr3(m0zV3N6GxSgg- zu0V5EcaDt#J-OScnTL&DDyhGnDL>l}&-CYh^0_-FGT2s1n#WSF#A+M1 zE{8UGn;$Wk&XN21bFsV{OB2$0ck>ej9jB@X*cW5_8GfGq1-74GpJxv+C!Un(Qb~lp z)IdAcb(u4BpzXM@|HRaV%j5>xy-it@i|lzmzq9xiNSD~*!5yV4;Yx9?fwj-WMwD3Y z7+Zx1oHW?Z##*#su$_jrXy%2at{6<3DS@af0#W%R@P~NL5c_QGMzx_$eK?Ef3jE1p zL7F+tMu$4Yo`4x?@n2?qxwwnWy}*ujT^;x~{{njqo-GP;?RY#;4(3{A>Q7PAhuXPV zk~U?jA4-;MBujVIFw~B~u9WAYu0l0?m>u6~Ca{nR7V6t|yvwGK^tmU$KaL$cCVj@m z>@d3rw>ktsaHINbnB7-p46{?kiykMShEvVWGRW;!ek;0BHQY|ZxRi*?xFrn`w8yM8 z??Ssr`0Y}q(s%VWOvhzXeJwa{tid2PsXHg4XQ@pW+9?>B0+IpY|IvvX8@Q37=rXQd zzoQ9sU9dJi4z;Rsz;3+d#iQUaD2KO=pr^%wlJ1l&@hanaQq;FXh{~=`Oi&YE#3$f+ zxpsoKmYnb-VE=RX@^B)koC)08%*041O|I^|Vxpm)PHe_O3zxyVNi@D$0^k zcAe{Pr(m@Gf(z@|fb=)UMmlsTGJ7nOFH5Z%%OKJKQD{evvwLg$9Gd@4>sDv%ID3~1 zd+E#xwj!v#2ShJCQy?(`oPk%n5q$bhBcIW81 z)D!{ErTQ3sTH(+ll%Op!JCrq6+&Ru$S)|Do0rF+z)i4z?(*T@D{FT3U%!#oyyd`c^%PdJ5#<3VmTjZ?z{;s_!M^u$hkS6h&XY+9T6P^IGQ$6Rc5i>nR+J{+tdCXk-6K| zo@UCh$jwYLi3Bjs5xVeBxDCcwBRHf~cc+bOM*49#WG7f_$=$#QbpZ`2|B_i*bGI$J zjz0I;owW=RE9I)0>#@Hny2sA=_qwK011eRhLS!=Jco&x{l-$Vf-I#mf?5v^Z*xjSc z{vT1{26s6T(H*<>WQ7z^sir7s`{O#5Q=woHLX;k6{*F?67gI$> zYtBUVJEJ8#29MZmpX%tF!=C^KQ~dASgo2K!6-%INE3{Hn$>zGPq6+&6hV)CH6s|X$0V%0r`d3r}x~J8S zN_zZ^YFq)M%zYf>Tcs+O+bLy9EwBW6fRRZWfunTpk9r(>vIbAp_6OM6lgm=SJz?jo z8!BP0brsNtqU8XpN^%cX_T!L^s^xZu>av0j$jOhB$dISi&u{@^;R=BBf+}7CqO6s& zkRkfOUTap6Vc!$BQU0VoS&dmv8TFMow+*%h8pJg>*yYoc2QkT)cBS1KqA}%9K{Aq})B^<_{A%F}8x!=W?A}=8BUE6VCMcZ5}6_bxT0T z(wFHNF93gW>K5DpFsHBpt{Dv;COvP@;(T7g4v?wpc{^4YE#&s(qC;^~^y?=Uok2r$ zUaRgX3wzbJ*JwX{C zxx-8Wk*r9iZ_@>N!cPO4C-h-hJTQ)ESl9X$s-Aj)cSJhq>h0b6hO1p+!w)GnRWcnTa z00-lwkj{m$;fOQ4*6!{Ol!KJ{JVHgoY9{!{n~@;2YD4z=il0hiy@2n0 zRgy{Z`Poq+9WA2Gl|hDD{gZ6YZ-HuwvLhA`>3C-`UblM&-}5#z^b=mUBRUDwydu~V zk>dnRf?5BCnO3~6`6yh@Du2TkPY_w`b~F0`oCW~%m-zpeW^8-YE)0~@gYM0I3;L`B zEM4BR19p0XS0Ox*4z*I|H?1sgR7>0ner;20wjysNDf4YTn})v)@kaq7frgi*o_gD^ z(wHg}M@kA!Agn{)u@48D9-PZSklc#UDyEOB8;9AN4 zOyPFq0l_lS=Y+6qyBw4l8YmaYziZ#^ez%RfW@<}}>fW^z1oz*4*B;k=c(UKK=W0c9 z8?~c4A;#JF9{P7Rv=OQRVNmXx42|W}dLYk5J4O zzE6PyuGXqDtVN98Zcq9^uS{@f3;VlC)*!9X6BlL4(()-Rt_wdvfP-#+UrH39mI}{#iOfk~*<-?YFl7={a!ecoNf{f!%fGS{bTw!!x>8Ne zea!f(`{3bK|IHJ0KZI5mzU=rdaDA|r*OMaq~k);4A^7z;G z1tdN6wcRVRc~ZtyuX;k06(innG_p@2aKGP1T{tEN0sb3%vR-INa;ZT=8IS-@)MjJH zo&7CpF!u+D{Bn^~5<0H{v;Q!#i;(nSxKUPfAy#8^qiuYcXthVxTrQ3OD8RSBgAwln zRP4}o`Odz9Q)89i(GpIKv8Gprzo1xa_|BfL=La=6&5uvjjPIG~pQ+04A^Aya@Avj- zJ+P;!+LjTx3h%^h%U#YbUxf!*g#&~Ihgbw0Q7;{`C&}z-_k;Z-ujXM}_TP3MrqUzM z?}yRj=sDz7t~hQetLo`vgXd;6dnK!q!^(ezK^$=+e*}X$zowVY`Xaj}KOq?5()K5t zYe!Lq{epl*soJ?((O6LX!(YL(<`H8);r7Jbb31S@>OpioCBGs2?g_xG!9j}59v2&> zeHDk?8`9L@!D&|VS=>@q^E=ZJW!CTZ%^Z-+`vWTWg|qh$n_atl)%Yi(;a<_*q^L1R zkukn(;%TvE^*h2i9j67Csw8frFkVc=GW0Kdx68G!DOtAWo<86$9Pew*CWB|NIEQfz zP1cbYUB1VpkCiT;fOWge7r=Xu+Tp_R$Z-3_FHNG`*I5sXsgm6YzWHvSA;P`ecRyeM za{KTL4hr|fF{2Mh^E|?*LXYR@N77Af;d?Ld8(NW0Yh3(9`S$He@B2@BKXB6fcPG7n zuV#n&)Csyi>FhzMY+J5T%nsKb7#{As*7Ux6>=>T{>m=HEht^A?tM_ptO`-UVcg}0+ zD+-G|L>)3gfXAu60k{=0Tl->gThOVsuLs?p*xGj)88)@{jn4dR`>|tPNGjctzdqE_ z{Qc6C-sh=-Q9jWOycp%{uc`8&Kr5o6ec4)@Ev59A|M-(eoX$=T@YQ}-RP~>3%PEQW zv5LxahI@QBxB6G7E^G+=ySwxPANPtHF+QBR>P1t$Qx)gi*TVIKvnbK`f;;XoJs(M> z-v|36Iu!wDgUszG@H_%LLqJaUCEz!tScLPRv~aFACZLtWzCxmYmZaA3!_e)eunSV3;!AIqYM4Byg6OkK*i$V!9l?Hi zs;^5RHier;pmd$NWJCw2;Jt@gf*)52V7nb5ciE+>u^f=B{*t>yE9R#fSboZ9btKg{ zSQVY-%f?Aa?P9m~U8Y4;a_wA!(xSuZ|7jw1Tx1OO+?<`6ue)u_z&Qdk+9N*2nx%&Gi>Bdb^ z1>btCvI=&!>z;>mtd5jZSrUkv2V z*B|zt?<)(Ov+}6w#fkCd&tajlWQZ?Hc;GWbeBCsZ0^j8N*51MQnfWLn)-PknMxf|X z@~&YQc+I;P-DSxIK3jiA;OxLjrc9x!a|Dm%`eapwqVQURf;@&#B$57Q zJI1mO&4XUE_6@~$P+f2Ke5Nwu;=;;ur?NMBkxx|W#bfZ|JRaqYaj{R%t>)d&;k1&~ zXkYR#_U$GjYot%CW8yCHT}e=Ui7((w57ErQ3bE>QcT`y&ZW^jCjF46Oo=bf1k!;N< zUw`TO52Jji1p!vNEZhnLM?VHUKs9cTz_g+am(2O2eM!=u(LUr=X;wVtEFI(17va1+ z#`h(!)nk2u`)mYCdfpQXs>|XkkIN{b0omhx=^6~^JXU%wLDz8rMo|0${KB*1tQ)6k z!6!sBE%D~X$-tn}Bmd$K32Nj7-+n5~n&^8+3;^+2NRWJ~Z-n60rM^k-$S7u*5chF% zJ20kb`MwD4Y>g`wj>QLd*M&04-gIE1CKvcNP~@Hh-{?5mDWtjjs|Yhwn^FzG+;^q^ zO!5Enc{`sICAZ{~vO~F#mykEfcRh`bz7j&bdlIdZZsQdunae=xE5gFcC;R$oC)+~! zQuu|8ycqb&bP!+IlL5yO^&)RNp^!kS>v+PrDL!$XRxkw?jv3<=-+1obZJgrU#oN{^ z;PSfu_{cUPGNdxEgf8HPsZ$IKn_b{q$(6o-f*$W)={sLHaj+`Bg#~m&Wh$DXsSt5w zoT^yxxqi}BzUdGeJn;9zbU!&NT9{J{S}7dXPRu7;y|RopcAvxT>D-*`>FE><}k z{PA%zpu$IOx|L2CdglhI=`b$Eg9^EzNy=UjCy6QNlHII+Y9I@4GlJv>t=*}vy{@j9eX-9>D% z52WBB_6A=n^QrWPAaP(;ECf0B-2kT;I>Gf88`cu z6Jbv0C~V0`+?-W^8wWzNuVWEl+yZxN{;6atZOgsIH}_vQR1VxipID;Z%9N^8zuyY# zB&e>p0k=do_BP*!$acU+%sAXCvl10R#_iw$8&kLY`UB0Sw}YCa)S=sbX=Zy8%G8t5 zmf=WJ9cNLt{)$%EM5}1rPRo*2=`7zWM9r+(P?8j9>}(%PkyMH0il-vq4fMLxyx0`y zw;~_L{~eus?nKgZpXO0*DvWk2`z&_O-@3~;Ju8h0g}-;?C!0!AY5Kp!b^4b$)Gl{Z zYG+k?H!QJ>+H@apT~()hXmK|+;~s{+ySnEd-%7-!uJ`(4x(Xf(U6Y^Sat4LU43q|> z@{#roR?nP6&_fNm&o@9jt&lvS zs(Mltj*HG0dN#*5#&_nw^ata_yOGH1cDvvq-!PBo`f~BTwRbL4wYNHRo=^FtdXaUT zHz!^t&S4;%H)Aw!TjwwoRrkTB`UM~Z`?$}ySk=$PpSFly(#!s8!Tr9?jBnn28ZC5Q zF6$7AB(-STub!UoOCiPf`99gBZFVZk$z9+}l}*afj_BmL<|RlQWpV~ei7tgkk5XGp zecko6i&wRSu<%ZJ2+5PZvWFPDQEK)>S^|nL3#2VWlmkr{`U0kEQlP*yR4At^7s8@P zsh<}z(MPG$MF47)`g##86`fEyGkla&tC)MtiZdT!R*Z74dIV63e=%1~j8pTduf*lb zaq^bpRlJ^^4Qd?O*A`7-)Npe>{lPDb_!&=^iMqH~Rsy zR2Azl#7-zV&fg<^Af-g9(n~sUB0tWb?>g-4i1T0U3O`>XKxr~Q7PI61so{h4d)~)5 z1ucsAPjwAe$qD|L@&tbpF3EVjIs5`rv{9Aq$kFeZAL^9gkMIftgy0|pIMk!sCHnp9 zV1hrD)|rVka+sQt=pX7H?osb{_MfKe6a78$SGKgB|8`Z<&L4%ZGM-h3T*?*6Ox z<(>3?kw-nyCApn*LwkRO+%7OX$-grEViL7h$=TT8XQXnfD?8agOs!A!Cpb?f``Jmj zM6K!Qzfxb_!7}7me314#jp}hje476b3TZsepB8>L=og`OVC1Ya()@2RSb)xQqSF1i zX^~q$I4kf=IGZ+|{71108GgF|3+@K#+Swly<{GUAcK46h3cHy!T99ji0hDlw z${gVDOSv-!__?Wlg4%w*AIZYOLgV(9p!e+I{`fF_S(Q$YLaX=+ZLP}lPyGk|nn)Ea zc~>zpvM=(pTv_MjT}-*;Trkpq*9m*FLK`nt$(Q&yYdE(lD;`W2?*&JaM)^N%5xx%j z63;x7{C(Aud;Oe?9PUR2__6O)HF=zWc_5E!yZ~7;X}tfI=I>SG{ky4o!36)cZfgGP zQvWf0+?ffOXyT$H!b!^af9%HGNy|dH^CEF#ILTi^jy03~i`_WD;{zIh<&Ai#KZ9}w z^K+fE;|c-HIw$jLKPskmYR5GHW`Y^7MB@*9vH!gC8UAeEb7uHoASkV6=QU}LKh{aQ zhR#GvXM`XP2%M{|8poboLKn1cRWn%@HSB1K#o{qm`Sp|hSOaqvrYgFQp<9QEdbG9f zdVf+&dA`-3Mo`_6D+2Rx^>>jz-s@VnMLbVZKZ#4AV@H4xjY<++DeC`FJ|4<(`C@HDcUDyKh2 zMKx>u2`7lb7^tmb$(mHivOD8EPQw_#$wu$9P@oyA>$CpxdW0yTNdmY=|_Ik)u{GQfXd9MMmUyLiS$GGvdAZz4(ar+ zGr4X|*2t%*oSVbAilExR+!ZP5MchkKt|JU~$qTe9LoIy)1kO--Ynis_r`IxM=tS2- zmf6aCks-sHF3a(+@`>H3{52cbe$@A&o5$9 z<$KKYrpSBhAd(r*iaLM1xSFqh-#NRJ~P-=z+^-EHdgoqRiXW-jDp<@oH)AqG-6$F2CiS1;~Y? zyZH%6pY2hf*QIt)70X#8$LsRsbVUlkrmA=jl{Zgy{oEg~70&-F*?qy%?^iQF_g^13Klr*J z7(UQc>0gxAQ99B7e^mM)$+5@%+#jPW{$EK;f;E&%#c68&gFbtp6fa9P5yL}$l1)JA z6Ohz#|0|7v>!GIkVW@3gRH^ql+HxjkQgg;U+@4$Ws zYP9rgSj}TXgZpDGSNe@VCcF}C!U(k+e7NDTJ529_>J%XFm^6*SrzHy z-6SxwFh$luN#Ou>P^x0J zudZ|dK+VMUSiybuNP*bp>XFni!q<164KqAa&+NOeVjArTrONoJ^A;YQ`H4ov2G{v` z=Pp!84Ru_9BO5z@@^Yj#i$&H@5Yt^2o;NxHGxzb%F^T#*@cb%Dp-Z9s1?_}%^Eh9? zC40QHqgxYqd=RCZwN|$?gcz_B%=czZqy1vI)3*MfVbVlQN-`nj{NpATM> zB@lsY={)jJ<^F=EgmLtj&ImZF@2`k~DeAsoneGVn)UTZ%5P+XX7mwgwk1G9|2$Qs> z@T%O?omc8PjlmvEn!vrOgxJ@$BK#pur>Z>zn9|kwGo8hn9QhmVrKoPdp?K*X8Y=zc zwsA!{M9F5);+2Zo*um0O!EZ>e(^cOFxG`qc24*Ei{iQ*xh+7-rcIm3hEsivF{xPJy zy*k<{)b{*cYpE*6W8`}N;l~;gC!YMLLJd3+#qRNy3tAbOZC+pqVw70cNj>N|7pa)m zMlzyI-WSAxl*}g1Bcru(SF@1cO4|~ne0^(!P-fX0-QT}5!r%a<7n>P~Q z7ZC?j$Wd+T`p>_R*Kx8n=sNe_^ySib#RHXhS@MiQ}*_r}XNOrpj(3 z7$@Zg*-u%FOp?;h7^!xoaN3C2(=1i_SVCN42ew-XlQ<7~Bq$|H(2=03$l7C6?WH)J zb~S`SIKJ)>74F`|S>vcx>u?=WYrL3sLCINR?xA%k*^2anb(PL?$%y5CzJl< zc@o~|#K@Ta`(g~z&rDHd>y|Fp{|u!1bTDH0ot}ZNo1h&0m(z>DOu*MK;w-Dj+X z!iuTT>vyd%e^k7IA$E#d*Tv}Hm|Rt6MP>*vb)?B%T{}c+6W-Sen-8dW7u2)D<4edGJYw zm$=-%NrrexXjA0h@+2%kxwz!hS-;;cLR>}qZ{YtXdC74yP9^Mv4tu} z&NF1^ZB}>VUhU_?^H3ZeSJcB87%49bdMB#gy~xs+*~7?}HhX|7ugU7d+^AxEfrL}k zvR;PROf?M3dTAtK%JCZYGS+ZEr?=t%AGKEXF)}?<*4A?b502ixhM_I9{rR-;3(@vu z(uS+PeGR2Md9eikp*Vt*MZdCeGJYfeAgrI^YkKNt{`HURXQX+Ej9T5_=#MRJXMbaA zNRJch)#47eN=Y&1{U2kFN!4R6O*O6|DBN>CGdD%WpAQ5ck}Lc|=Nn78RsJVi`hMVi zV{lm1@rDLfb`PQ5z6OMnv;lfyj2}P;u=oxDY=qDc0WKl#7vzfFDV$~(F%_5H)+MEh*?W4tTF zN|0j#rFh>hJ|K~|F)CzN`@#p`=&UkF7-mRSpy$3xu|y6U(XG_qM;Lz$|BzNW-KLz= zihLuDCFHNywwmgLDCHHyy=W67jffU-trod5N$nqF_*C7~(P8=_{nMS?-KdOsqYH2< z$xKS;KW-A&gH=C~Tbv>^3esPFnbAY%J&=b2e+?LwbvaaX*Jb2POS#&=;HC{}t#Y#nyOqQR;+PcarxqSP1P4(X&7AHeWh`yj^P$-nylv_szWd* zXkM{|aJ~{_^>G?;)3Hg`HDE*m# z6fVyWjY-C1;nm<>8%}*d&nYQr*Fn8H*^r|Opp0ZRK-M4vv(r_^;*f()@`uEmK7Ex8 z=Ua7P3S!lFYV}lxj6Zy;F-ilABkw9g(HqNKN9gNLYWGAO`opF%j_=j@X~qu>{=(^o z>*kAAo+nx*X#ORLBygC`pI|n`bGosqlkB!cK-7=qwzy{6snlugOIz|MV>B`-hIukm z{mJ;A-|x*pa5^Mvry<9^sbiB3ukt+~78UY?D_Mse4oKKX{P=-FLqdK#djp4x|aF-N#0^2lB1(KA7g0^q&kHj zw!C`0xodpbY$F3x{OZ}py^%jtOQeoCeJp_*IEMv$QW{XHZ<%o+r`oIM3fOwB52DVU zgPinB`({T|M_o^%gz7m)M98o0)z#M-U6gMi{gRxXD(X5TIpj383)=_Y&$!Nr3OS=I zK1@)dHq+^bW3D$M2rpzY!Dod;3>%NFPxe`L5@X5PgYl?>>y6&3?s|yUUOKFNB|xO? zdf*${^aypCYS=37;g@eNKniEm3}KNqeiCKJ+!xDE?72o6CpDzcXR4|_I6tbZIIlTv z9)ctBiuKpYZ8rG%SKfde3^Phy#GN!Hd1vJHigc?FsjP^JG3WD2q%`yd=bP2eH~!&i zD+PykEI^}*Qnd?=5k%V5E|dlqg3ImH#D&~yuhO@h?uIWyUlt;Vi z2bJ{-5`X@UU~8Oop*Nu%y6EHb*OWu9H>PUB)M#ZqgLXbp{C^GVey0IZxHMBfiD=TbSr_ zs7g-JJ;r1xiq3I1^F=sQSx=Hf-*pcVMXA4s1&-!*5Af-(BJV}I?;$M{YjZCZdg|Z) z{Ckb%^5y9J5qpwU=|kv66!)WtC4rB!E=Q>H^9VxrJz$*l@T~q}BcZS^GHlbZ)db5Y zso@Vo(34cwW1xVqlI>2pk%aJE0@h*jaqB0=azgLH*jo(zk024G9<$ZNfh*}kb#JjsMIy%d)0PpLF?DwCaWvMN$EBCIWg&{P!4 zzQi|u?bLIr-gc_&El7E)i;LMSAhX-w1{co{;@}oyXtutC`iramU1NZzzk+%f-2dsuxGsN2cOsq%ijl~j;Yii@F&N702$M_43+W$ z1c%>Sl97U<+POLF2fB{)7rWj?RmSBw)$^*1 zU*)UyYY2p`o)sRWHkTTKB*+yXL6hjvM_@8ur;|SMM;XZ~|4C}ZOz27vA2Gx9iA5Kv zoNA^Wo!yVEs^V8PCa&S%QT?}1691%C$F zGCzaH5#RioFl;}!;shaQB|uSEeQspL3TF+n92byBJ~s-Zhk%Z9=>y22Dz6n=&P(dXM*ZTlQIhN$n~rt@iWIiBF}{NngH9bU}~wZ`YSOG1Rsd?RRyINR_ko)NJ?NIlss|KI9~ zyE9nN_#gEo@F`f25T|x68&st=V9DXo1oF0jZ7hi#8U&46_cimAppJaaLK~)1zd=M| z`~5cza``t#A2Nrw<#0 zsabm%Fkk9leZ=@N#4{qe!m;7)hr7=_gNv%}?-4W&{-> z2)uR2AU+j8@h#3w6!zddM#o3#-y}mKBg8R{R!xMBi9LozYqWedsc2kOOkwr2WOF+X zNgCr$e8~wTIs6KM*H-17hZAuB31hRXCFAz{Srf(KCymEc$Dfei(vsL5dh(>PT&d3Fg1`b>-I4zUl zFFy_O4AAQGUu>992^=r`H)E;Vd(xQ3VJlcGmz)x6If``JW!0gC%{Leo7oLmn$%+}t zp9pD_8B!Xh{FCde0{FqgT}d!gwbdbP?GAIK-aH|7MEk{Vuo_D5^O)m2sZ-8sVCq@d z)6Tk{u8Kp@R3 zk}o^loCm8o6mGJM>>8Jqmi#TA?ExR559Z%wg!$LEHm8N?I2#V*xW5(KsoIz$VZy}D zC8#BB%(7<2&DteI5~sB_g|ub0HGhE8jE^!~do(?k0Lsf$`DScU+0kYlc$(GDe8`jO z2UCb<$&zUttmed;BLhJTo)t(;6|rUn8HXSl32Ogok}Svk8-c7k+s*D3IFf?kiVmiv zU(uPcmvk^+@XT&P`^j-YcaERt3AGc$N*oD0ciMzYqN`(!$W zDMc~ zL=oEqwBRJ9 z6nII=!=y=g64s8j} zeCo?{;dtUQ6SY(BF9_V%>lM;Hf{`v%wYeO5l{wNJ;<5f)gEy-3%go#9f9mBX@uQ3U zIit+Et;st@3B$OOdCKwco?voV9ImrT=Gf?)0-th~@Y*_TEvqJ(lRb<5wUf-bAslcz zW{Nq(vsgVf#atY|nA(3p2Vocfs+sJ^ESrVSQdTG@{*)sdk6Uj>`Lm~*qY)lKZi43? zgCP&QgXcBVO*vgV_D|*rx_8x|%s6*PDI1QS=9{@QSjmB0JNsvtl2nJhJDeu(kDX}} zC9mIf)WA$LjW`v}we>Lt`I&-fH|rG!mLMN5eNU9yYt23^gv6j9sOTM(j*Qu+cvrG! zn@QRtkfqW;j5howvrPo#TXdt6McQv(XYP=sr+em_&+_5CdFIe_c1=azV7mEdTdRp5 z;{h3Y1LUTc+Px6G?xj}TU>dO+48ZI%{$!@flD&*IN^yfZm4bcwxPAT%VPRk5EzD8W zJMmG4HD9A>_QLcz^UpvHtInTU$t1z~vne*71AhiEYzUR)zsd6%6R9lcn?tp?BrTlCGOTLUWQ{0gUb-=AE*I z{~x1^y-~xA=K2RlSG0%)Mbd{w<|p*Mc2ThJ?7C4GW}A|gKxbGweJ8?q#*L`N`B#Bd zTe3ky2AKmM;}OdV^d(;HP9)zSskn0V7xb&+ZV8JCq{-GP^n5o7Wl)v3n?_{g1gMEC zyOP0uvALhOb-Jn)JKW7;NuHV-#G$k$<~Mp{w@C2HuR>hAlHA+(ou_B71~e;1(E*duy2)b`JE@FXxVq zk|o8L1Qof(2X8gy*8h5S1sw}k*?cQZpqCnSo1VZMZZmspx0CiLsPu_6Sn@$gSY$8` zfXQ%cg7z5omTROJC{5fz_o{RG$TFd+mrye?Plo2dFwdM2 zLd@EIcbb=ImXZbrh;Ss}4Um(Qcbc;ACMO}*xNms!89iEgR1mF5z%?!CB@`-|0ql?>HUk@tZvj-L%Fg&uP8?YtjS z4&FVW@6LL_Z1C{Ptkvcy4eJ~E2u2HzY*7`ffgY~k)nLnCHJ?x$A2dJhbUU~u{?R8} z@jw2#!w}nsfAd3TuE&$BrJ2I@Q!qr4)rB^)3e0~{Xv*1VJPxP)GEw^PHQ~q)vvyz% z!`GM(kn7q1-dZ|Fl$=oGZOY`Vh2)i{=}&tEK@Qi`)9cIzj6VLSiy0heQA;(kg?jE% z^^coBB9PTSVPX~Cwvypu`Dr(zib6`lf zdjVD&Ksp%!lu!<#1dXIyu2o_?sfPDqDXNrM&zjGN;4n;m z4kW|%Iu^}65fpP$6*%h zpVxDpYS^3(_((v!Q8mv4J?LbaxrrjHGf6Z`R(B37swdc~?lZBYc?rVET#v?{Qf|8W zYoMhwqKu+lL{ly(hXYOV|E1g<5TZVPoK`FT0sYlcmn719!8BWVOdb$JA@)Z}__)e7 zJpQ|5SYgyiy_>_FnQLpcT>~P z%}qa_ZuGkts5l8>( z%1PMSW3krlf5kM%lmQocS{^9>PATI}M>iEyXA*xwju327>i;89|Aj#LqFB7$uw9w@dwK77@l+6_fr`b=L<{4pyf#BOaoi(-eJb|l}9pXq9O}#m&ZZgF3);! z9i;T6JR<9Xb~(4W&FBRmW!k0NF9o{rvYNQl9PD{TB~}RE+sVZ1ya`j?f*9&o&1o(A zCS;|lZ&a&%)$Ff<+~Rx6^P1`Wm)jl00wrW!IxW4~f#rQ24wAH=F;gsk&5Sw6i}w=ma*>lga>G zURR#C&FJ2j{aW@Z|k2Uzh$AK36OR%(u)w9S#KUeHkdf!bEpdD+1QnU3zhM5bM+`QbqSI4eFtX<$&_`7pk}A08Ha^sL%H zs@iu@QtE{GBB*vpMex0gFkP?G-$e=d4^kue7_hi_-!scJPnI>-jXx>nn?KR2%%Sk- za20z9u_@(U6o6yg*XBRNb6h39Zw?MQ0ZHjduA7>FhBfiD_@AjKt5XO^Z~o+8Fj4bK zRr{(*V9$Tqvo5h1_Cs4I7w*Xs>E z;x-k!D1jzIn`FiODzMiS7R%;+2tS8EZiUx>m+9uo9m{65xS}Wwf|*sO&J9}y3HnhT zszN1|72ZLm{;{pmN}4(yz=E_7&1u@6g>RE>#;WW_@o9W$?nRs}_$Z(h$EwP8L_qBN z$ebB)qkEDFH~BuCb4)U-&8Ti7ibMoDDi&%HlLRKBUJ8*H7`yp$qJtZBG}u*XwN@WW zhoUK0S8I*8awuw7*#I!8t{Q!3it4%ByoREA#DR`YtJsaGPiD%GVU=tG{umkYsCw^X zWbLD@O^>Qy62n0vA7evc!^|gUTqn6LGcVwr9q82*b;BnZ0*@+>q!8GDk>ynjem1?T zL(%Gt|TZdF_NBF)@N{%JOC`68_$%C`^wMC5gk z%6eYZw>L;qoVgEKZ>3tek72L$7wj`}-4QqW9o;YcC#EzVV0#H8s{F$IM5opZ!O|l^ zm;23_kl$j|tNYEzLmF6-2h8hr_;rik%FL{mqOhDnuAMd4PGq3-u+8M~qA@ z>Z@5_YF*6pmH9+`b2=$Iuw-onH)9v8onM*V&!Isb|H@oU^PKh&sJA%KUm^56CuQj_<#eZ|HdA{ViEjcNL3!S=1=~~%u37R;|Yri%TyUU|Ed*c5OX9gvO*CFmab&Gz?yBbX90I?2o4qkn51rTE{b z(xI|rRZg2&B+BtfiZg#;DHHJcX9C-6exT2!yf}{==f0DB7B& za(7}x&Ob!h!2i_;w2lb~$JJe7d?iQBrD$t9pM~#qI0v@OG6Bj_gtBv!iJeEyp>Bw; zs%?W$B<4qRjmL@v=EB6pZ6~N9lB9s)R<*Ov92L?gRz3bNxQ4IZT%v=MQ+X!jN2t3@ zp$3`ST945q7&9B&2UYOokr0fg|1sZ{?f<1CxKpu;FtyBMXmo8=)M2i3Q^BIQ<8g}G~Lrlf<$y);|O-1L^)*(!6_`cob2NkI`d`r zX`ICs_e6vh{ertMM@8Da^= zDGss3Hy#;k$@Yf}L#?sehTej_vAAUYj#LFB6CtpnmiXXv9`+JG8ET~vJ`){gC9xHq zEzU_EZGr(Ka9^d~FMgzOiy^Dk;nvj1xWMZ4`HzHKY#g29@7daV$Yb3Kc^COLi9a1G zMJZTuyV@OL84&tI5wzUI71G$Sm=$SF;t8~$P=K2VA*znFMtj0L@(DH@-+|*SrLA=m zXJXGNYeK;8!BnS)N9ep%BJG4J*?vps%A>7GI^ah5w2+gaGRApx?W{!}s}rq?7e$_f zCz_T@2erT0Pj;K>F_y%@<2`o#`7u_td@!qn^@h;#^Wv=YHF`}_^)C^Bl^tjG;PJXR z>jAx(I;zBDxTZ^nv8&2m3llp69e488uq>jL$~szNp|9*{Ndju3;N$$KJ6bb6kwyTb z+O+WiXm_Nu)jiT|yh}@%6{9e5q#4#RB25OFR%_|paLW>tx!7C^)7S-4(>;-BYRej@ zm#8ddfrE@yy5#Z;;zXGK4{#&YO{cckwtBS4_bL1-NVZ}1L&yo7ZCi5!u0kT*-57S2 zInf9!a;%O59Ck-vEaeo(`Xk+UPr>VpouI<8#5`W*ShMMNs@EFq?(MkR4VBN0x6*iA z84sj}t26Q72cPT$7IPX~7Ylg+%9~(`KVU@y4+&OG0F|(#^`~3A60Cvz_V}y;dS=2^ zUUoZ-k{=KWli{-#@NB2gl4a~kw34*3A9ndRKAW^eJrfhTO`9Tv6=o9@pW7aZGe6N1 zf7;qa>jR!;b+se}=0I0#EV+z&CNThRCV?lmT9HK0*wM|EcDjWCIYEAbb&7f~$x0HK z98I#iMmmAH)H{{p{C$!w7PU?d%9%!=u&*yWB{tdP^;dSY=6XEwLK>hR3d_>y?pBSb zi{b$mDe=*t?hcoj+{5yLZJL6VJu0q+x|j$Vs2t0iHUtT-Yaxa(nU_YnR-J*eLj zY(ndMSsOixD!n&wA!l)K>jB0Cp-zf!$?wwp1c2JTFlQhEno}LKFoj(#Wqqt<0ht8N zZh6TOd`4dFueN-GcQK`}H7^kFnl%Vfq^z$+b}qO>8|KNv!s!H1miNCfw$c>qD?F}wsh~)*T9;~#@^n+Rsn!gl z--e$LQgv4g&xefkP&?(Sr#f=JH8{K%QxmIVFYAhnG>cUcGlcj+-vE%Hx0*G;nxJY@ zQFwL?fB^PY`vzD82oMD+4i?KIHPm8Xh&GLyHdf|1fFSR#+%J1`SzVmwQ6k}wv3Oo%BY_> z)hn-+US>Tn2zNQ48z8Lo7OoCmF62VZ;&4T+4-Sk~{c74@td@>qjdRBRDAp=x`Hr&s zhYte4?Nn?VG{CevB67=;Q4!PHuvr%3L%r||bcM>3VB9bxBEmmxv^6B;zX;QLm!o6n zZs^ppFr!M27{YUb=640d*92MbiV{U2w+G_R_XlhY{9~=rEeNwrw2)huU$CZv)X2>h zkhzhl%;a&F#9L&Ivwm)o4o2P)_Q!7CT=;qJc&iWSv~|1&MoS!vy;3ux@mE@Y0Xly1 z$iWO$TBugjCjiW9wQK@ls#a?!K!19vGjbE>RECwHGsa51RuBF}Fw|PHn#d#15PwdF z)gY-1$Sqgc=0X}35wd@ndbK-;b!Ciat5C`mYk%xTJdyW>LW;Fws6T$H)iy*QvcRK8 zegnC@Xu5TtCF+9!C&-61=i<7n%5zZH^QT)8`rVc)j(Uc7^=$nYU1nII8#0Vg{saQ@ zsdMWxJ%^{{KUmoD(gze=q&Riy_8)_&0c*u z%j&9|lo-8c_m5^-|NE%rtEk_TzhJx4)n@Nsd~M+U->G}l6X`?Vm+l7NZ#g&WLEhK> zYB>oqRCXL*Yf0vizRO4}QE@XWK*|bGDrPp+4^BGU5^GBRZ0j-Mvk%U(j_Mr_z4=&k zxRH|VIxQt@r)KVtF+SxBLtRX}-Wn1vINMfv9%3&=$@SJZk(Y8UD(DEcdam`OXQY3{ zJnQp_@R8gOFI?Tn@Mq`nmcDMIJktnmreANiVX;iS6U&e9PEuUtjzo~%oM#c>)6388 zQIR^TtG%k6+9l3kw#rJ8luxw}TSFrmT>N^78a9bf;s+EJTaOSGh*E@(unJRVMX{AZ zKw#|Sa4qZ#k6U-@TtK34jZ%qoL*lkQVP%K58Ab18;mx^My_(zFryhOM>I!6bKFOLU zEd2*ti^uL}K+gut&_t*|F9fB-AlslakF_wxM$=vh{+S!Bd9<@Wx`3g00 zoAsDytjnM>YrJfA@mnhcRf}E(EvNOjIa2sF%OrthD43NPibS@Uy&2|qJvwQViX4Ho z-CC-lFEmAv)WcsB^n+kVlJCsc+?1C@>++9($s)X2YtlEHuWb= zMeTrTu&=t*=}(4Z!p(Abpl1YXsJfljyq+TN1sjr1=!TlzYid02RgFf)uUg$3eSKog zk~hQ_3-akDGfvgM3OtKd^lR1=d~54#BJ``+3YO_MmE#t>D}X%tyFN#Bh^a(5U>{bc z)`tR{Ri{@X1#;45rL^G(aFgh_|L!+L;knYk`b}%9C-r+eJQ<4I8uk4L{w_f6d;y~V zAE0_Uyy_1Aj`P=^>9_d{Q|XJ@;$HRuriPTanXk0B(GGI_Ti*sFI|w9#i$RwD1O$lq zXwEfw7XgBW`L6Xjv8|%d`;*_Z_Je*$@Pt~S&>dRC#P9bdtr&dZKwvEr4uSBh2 zYxt{zUDjgjfzu5QqOS_qLyy)rc$tpv%N*|3kSY|kXM^&_j0+UeCGE+JLbAW*T&J0QvBhNI}z?FJpH)%cIm+pE=q zj{&Mydr|d1j}0F}R&HMK!i?PWUdQmOl_`6}W)rXc${;y?HMJe>Zj z-r7gS+$X#d@q$!>0D>G+itYHEo#@tlAxb9%twcBxOb}k_f`obRucrOeT0-xt{)yl_ zKwb8QH6ZNF3AS}-WOMph{ufqM$l(*}@h_|k!uHDT+?BRh9s2@4G))!nx7=8{pog)s zGr^9kypAX)E!ah3^S%j56?B%q1(*L!6@7rIx=gJ&0F4;rUv~ht5>M)ZFRck0C+1VR z#roh(@BmKCSLtc7SZIYTW`AYP@eEXZzS7FjtQu=V$l+t^xf<*IklmE?oX+ZGjdd51 z%qwa^y4(HxYOSFmDkdC@Tv=)Bj7aH}aKJK^^NlrBZTXOi$t@#+Tkd%Dn_b^PXpXAX zF?RQ&gGdxply%U$Mb$()eZpnYWfhjPhd;Nc9i~}dggSH3N{IXuIO+nQfD=P`KhjE+ zkSSfOyBhN?lwpQY2C?U4^}sVR^Sj`e$XGGfM(YaX4|p2#L8Y7vskHYyZA?4<9j1k8 zD(8Dys{ZgpR;U{^-AcuN8EHg|%*5R2F3eQv{|3%~XB#Q<`AnA+rTm~*WBLzZ!z}+x zKd??Cqw3u?G*g{9%r#r|U-2fWn48f)V$Q=@oPQnvt4K$~U3vuGto)~rSigp9@uaoN z>Pw#T%#MW9WGoQT^)({Dy#KLAhIla79Hal&h-ea5m`QL?ru=l&^0Md%|BhqUH^Mnf zf3_NscuG%N38GO|o<>A~?VlF#tSz<0asu-oL6PTyRAtoR^2@jw=U>?w%Z$tlfLo`` zkVV+-H%)o6enUwYM2u7E@1t^+{RVH=Di-QiVY|+%O@noU4|r_8wl>mPQqvcyMq{W2W zyP&-X!fnBU@K*M{q@h{e%9c!byIXN{x*ER2n^agmFv6eQ+MXvv@c=e zyS1^C+=(a4{oli2ixXf|*==nxoULeUyGHK*YT`6zr>w0Vrdfw(SgO*4kE6ORdF76E zvXeQLU0m7Mu&Lg+ko0ZU$BBK)h_by%r=^_mp>m__9(@1lDEoPCaU2)oY_z@IwooIv>le|`H5$9G)pxQG*0|WuwIm8H`$;V*#Q1o+lkMiQZ>6)7N{)G2OnieylG)jQM3WGqIU=V9y>H}} zFn}0@N@B!(tR~^{SCuH zoo%PEdm!*Q-LY@uo$?WUxZ1G~Yr-d{V)?Mh1lNO{QqFBe(!}53TXkN0j<$Qo+x;}Z z5IWS3Gv5Gq#Y-5}=TX18A}c=QWa^;E9!co0^7AjCaA4fGx^rAM@Pc_axeL-ILib;LMr01hQyqGojwiw)mtY`ojDH99sS za#8b#tcwMxFS*@7;y}A4-Ru~ClU&t_%x|k1@>_EW|IVKFkAiu$+dZ;r z4z)kKuD6}6U+qD4K`QxoIe#vL>Dvdo5x~E9``DWy@i~3%*Vvwr+Rv7J-z)mjJF;C! z@q#Mvh?A09+8|rh4uPm9pFK$kM9QDCL9Dgys&xubaDr3>vJ!k&~YIQjR4b|n8ZIC6_h911OFkLgh8gQ<=W)m%!`fwW<^D6f^n z>;}jRy>9E#D^vuirrFh1>n^q>n!o%8L<3pG5h|}ApZ-a$zJ&hlRh5?nn{`yjG<#gM zR1(orP<*L>VH#u5_oQvPw@g*0Go81pg_qi|w5WZXqPC&NjR5M)Rl()Ja@7dCMKiDsxTsIR)Xp*&Uofz}G@l*t&zr0x|#O5b?6h z_|WgeCer_ks(<)0J4$y#zSabu$jj~Sv4j89&>%4s@=s=&AePHPCZehidJi&V^=L*}+w$)z?YpQOekMQPe z9qC`?74`$c54tj-S~eCuKqDS&3#oZ)tR^Snre(!b(~^pBDie!Gyjg2_ypK&oYarS~S= z{dHJTvP%68sU+qqdkbpw&Z~I)jv$|%IK_5|l@D;;)l)RdqCtegsjv#j%TztO6;tiO znp}>g^GW=PPT7Q2Ra0$8cOm##^rl`ax`$74M#fIFM`)|j7&UPbJ*m4dk#pOpu|!30 z6USQ3bP*L)&p)|T7m2=w0!w2-$|F0hVkUO#qmpOX$pMkD{-8t~%&;SL4+XqJu7o=^ z^)PRSp6PWn?D>sy0YIf4C-srwf-9W1#V5u)YD&@X;1Rp8=N16CYF>JOI@F=bCMVq>T8}e zD)w3!-pU{iQR&y(M&y0LOMlk2HsKMMsGQmMEuQ&O*cw7_K^60A8cq4!8s^UN#=F= zC-gf-S&MbYE?kV(gLGyRUYP%}#yZau`xT~f=Mt#W6t!;&bNx_YbqX7h*Nau;Uqo#2 z7ykva8ur9D$PXF4b-KsCx3E~C(YNTgi*M2E@xU#1Z%rpUsPgTcYr%9Z)ue!eV9BMR z0fCw%w4^BL%u&!=mTE-PgtyxLO}6pRQa-iU81KdzESw+ zGCKo|OTE?pge@qUoSre(X*KLK|BWq5aYEYvbXr@K%QV3Bv}xtM;JhQE%z&A&@8xza6( z{Z-u;?R_Lfmvppqu#!gHZGQ@S9JpKK&zZZm5T_@~XXr^24HP@27KZch(L^|4#g^IN zduQ&kH)%Y-KvmvJFw>5E?IAj`e=<-MH9*#~2z*LKuC&MgmqcYj853Hz5>R8bSP6xF z1WX;st3Rkb6b|kN6q$+lv67qX+Wpo3`!IPB>~%jJe4VPlA54B!l|Mk|A9IWKZc*$O zkGsVaZc!oy;m30Bvu_n7wp8V8d}(XD6QVvAdBb&KcR;(1-D z{0DJH4SC4!s7^j;A5&%dm^NNk`|_EqSJWvA)hC}Cz5*1DooZPD_g_`(qodE;xqoLwqbQB=9bhi>taTU5KnZnyYY7i#hvx>on3 z-9veccl*14^itMq2iLjC3&|V#oAQ% zh}%J|O^?|r>aaY`e9RuFMy~@Y_R77D>!{*eZzmT$%EO9B_-^hO$P=0CZ8Q7_4Yu?c zqA~K<+an_n2hgRBs(h6BIlUfG9#OHy_Tb2)fk&-X9=I6!W8-CISKiJoW^8q;v>1V) zUZp+`m`MTmI7G0nh$oym`#4UMm}0&@?Fkvt6ELphYT^^n!4oR4#8#?A9&>a+UFvJzAy6Cv<;SZs1!j0qLOnrL1)_f>o?i+Lsa!s3@q~*#Ca`SAU?N|tkci(vZl16 zj%dM+tsu{8`YI;D!rU+t?=2v6QrWXw_Hgs)1_cAFFi32n?cB}n4gznH*+ZA_QUQj+0+sOJ$S*~f%Y07@pbFQ@e9DF8P9el1y z&Z*u2V=LQ%y?ep)b{|crhpL=Ek-??xdCfImdS0t-5LOW-qqLIHLkJpwv-xv5Z(^Bd z3|dl3SDdAk|3`{=3R;4og9RN0wI` zU%>1zTy=X<)AaNT7I5Z^_V;Xl8MDp)AiO=2pI2qAicP{Bmx%oAha8dD%70E78Pz

sMHTJPo`{VR*Kc|?SS-znzbE^HQM2J=0m6JP@a)E+*69%64$ofJ}e_? z$sxTjYyJGbm$e=m;5|oPw(sp5bYQVa|8OgR5&$CVNOR|w2xutd(v^o#`n(z2+2(n6y}mER&Ei3}(lwS)4!DyAL(!dF@5 zKy+PuZ&Dz`No)sK+o)jdasI3dLhvjvN!F)ntjVCMIV$tO8Z&xSZ!gAY5mBzB< zBHpp1v~qYM)w-(0_8eAs_{wN#${Fyo;$@_l%y*EHI;-p60T1b5N3Ww}i+@xvy+hYI z9^oA%MZ>@FU9=8>sJ%;d@4;qG75Tp1Un8tu7JNbCb6k**e_!LI7JtfGQ+MP0*uvPk z^#L4M!$Fob&J(eT>+C~)c0n;4McKP|(H%>@Bt@}0vP%oTeXC$R1Tt3H8))N5l@^*w zk*?kMdp@Gn3oML7g*zl{8n@dH0j0-(BB1rJ_yin~_Mrh^ED|GTn;^8JGLA89Y((jQop1uHaf(q7w zFEq6};}-Gz?M=J|J>Ybt{WcjY96)_$j(7ck4xi>H+CHP8DKR2jDU zPkqZA2H+dJu9b+%1>ZxWXR0ILyO?yyHmn?iAY{0*l$uAJ<)~SQ>=D1$EdAw&>}v#v zVt+t3?h@!hqdmXTYui)pUc@>}%jE2cWh$XAHD*ZDyoh?7$jnbxB<#``kaQFwi zj21Ov*JxJKgIL$o~ej!>g%()nmz&o!zZN zm_NVHmUthIM&YA6w0nNw^>(U!VUw+e1^W}KxDR+uR`ucXz`x=rOx=3_$mqa3Jk=q5 z?q^GnVbYtTIvs~7=cuQSW7Z*v=R`A;#flU5SKOQRv%OfK<;?54%c7S{?4=At+Dh>s z`PmK?muUSd4VBnmgoyb2{$kG#AxgdAwC(0H>aHff!}(a`N<;84(EV#3MO?}BvT_ce z)~eW<)0(rA(>bXy^9w?n&)8*=T?1$k*pC(S4?>@_TXkgP)Cn@V&if7d0OIo-3a_4n z20M}IjvmC{ zc{~elq!keQR6)37#CGSlpj;5LKJ`+#(>vV9YoRK=f!LeV;f^o5NAs3d&U#Xhq_uMP zG67a=XD|i0G&fw3d9~$_OC%R9Ijui~R)twRNtkLk+h_BK+ z3d`*1^Z-9nJ387FUEayLM3ASGBWCp`LyKIAAx6JW%QCB-oq)+jTtb!ZRo)VBcNJwg zZZzEQ78uK0({>tYX=kB@a>EH&lZ5N7Fm(@NvvHQCxsUWzK%8j8J?1EO?~L^udm8v>+a zROOW&6R?xk$2*H)&{O8X8?$^x(}a%|5VK41JYqDKzUIWJHOWqjo}=?s^bj^##XJ=f*6Cc|9M=f7 zc6x9^6K22c^PF#pB+Tm$ zYI9<6cOW#m#nn|Ut`Jk2)tuVmYFdk{>CLay)xo#nv* zjNjhD1VG00alG8<+s9E9Z}ri%LvNoUmpSnleVr8RIs9?A4YJ+m)6d+# zPM9_Kzf_&qtSTok^>s!@-$2!%tW>Px`#DKEMUQ9`g1CQHZi&-jb@u| zbXdrZjR2wHxq+vgzlupW4<}M)s?&!zSEth4qF{5oQ_t#XcJK)w!b5q!(@`%*8HWH( z7No2z852i_4$||p?0l!Urb@wD!R2~WGdN9hzn!4Fy122c%w3BoOB$cl4}g;CS)b4X zlz-8m)x(1h*I>M>8|ZXwQRU`f&-xB>uF;ugg7a{ThHUKKwz4+L$0x=W8JMMa4RXvD z4J>Weap=GW(CB4n1BR7$fittkYqtjL)L-CC&AN?mNo=Et!NN6`2d+B>u2%%ErEl{5 zuYqgvNXqr?fomava-AEv7Wm6`o_cyPAi_!OE|Wn+ptLw?-K%9o-~b6o1Rko&blt`4 zQr;aX?`a$(HAC)gggY}rLc$B3820xztq8U|_Hv^9D=&0>9!SsA7dcabpl7Hv!*id| zQg%HiBb${iWe@wBq0SIIhP6W>JrB6WDz{ke77x0`LvE4p76rOcHA9_b(waK+LK}Ak z1y^fR-h^&z00fa3997o_s>GjXb58Cpvn_x?vzQv3+#>*#g#OmiW|*+;x@BvBp-9(#`Z2VLfT9*Wu> zJ;u40LI)IOPQj_WWeg-@xY{?yalL$Y~# zIHFnCUjc8{?##ie>@$py^Ts-(*)dZ-7Gw#;s^&c7#H*{<5dN7q-l_IH>W{tBA+`5# zH!<<#3@7CrF$$G~VhptUl(Qr47B)MGm^5za!$&n7XY{n42m*b-TL3KL$*A~`!Zn-t&`e+2!Hs@;EdB*r4o zi(HsJ$?=|}Yr99pB^2fsq4}LcSV-$nfX1##j=M9vcc5Ps&CZ&No~-*eeX?}KzizU_ zS>VO~iBlcIAB&YW-I=cu-{7U7y&!=2cgAu0=UP;$9n+l*`i0$*N&S zBNVZP*K)jA*fT2jRy8o#%Y;dlQVp1k=4}BYd#t4RHAM4bG~_lE6@_{bWR09CD7A zcCW|h-(w*lJEq1jbY8=~7=5GjipGffD)p|`kiQ$jh#Yn1MrI9z#Uf`$wtn{SA73NyyD6KgRtcUn85+;%N? z#(_505@%HG2HF)~8^NFO#*O}*C2+%lZ$OT!q6g)FaRz9z*`69gFoKW~%lAcY?)Loc zm>GOGJFbDLU+^ePtr}+E%m=~#v6fMoeIHKin|0h6Rz@re7ehbuXOavN0(gt_3dPP_ z823}IvCy{^ZT*-!wbYUQ#q5i`MNcYOO1HGe!9Um&R+xcNWY;ohntt#Hl{f>+oBt71 zbo8yx3z2^dOo&f~-{$;^JJz#YBxQf!<)8^3Sr%G?f6EFqRuOD+SyxO;p7TIxC$!bq z4#&l->cix_{y+a0hOSn57(&ycW<>ZXz_s8UPnw!Uc3sByxr(bgk&OKgh^-dUl2zXB zM99{V#4s>q{9Vr6kf%GS2d@dU3$yQx2p`TNr}zygw%2>Dtn3J<7{^l%4a|1lzCLdQimOa zDP7QfQ=#pn3!E+b<=(3NvsO&dPIO}5!_FG50frTp4#oCj68`e(!&*f<@-S41l~L$S z4c|(y11a5}6Dl(TIf{eb*;i8Nm|98|ktFB`d0u(eI3vRK`Ch7WFT!}{8an!;>bsUG zT~SYCV6n3jfbJ~DOoa9KaX1*e zJ|1`GYCa*8BCASPm&+%#4`RU+Gz-Ul!nwBvw+<=^e^=v6oY~Uz5-mO)DM6^6;+H*; z63?=F0}28`5*t8?DeBY);0Yo7nIM-6eU_wHZP213Ik=B~_qn`LUf({BO`^v)!r~e) z)#|^&Wc2=R7VEn3u%b;4M@_4(n^;C11ii_*g<|4nN3w=gZ3e_bk}p+>TV?;;$<|?o zncuTN^J(z&m_Pn$hom-etY@%+ols|h_2u;Ms7n7k1ZbO!3T4+27$bB|-f4Dno)9+Pm#|9S zV!7=jiYxOUG^5`q&gmb{8f8ApDkysm0Y77UCtQ6bPC(*#k={=0i^Fa63(h0%jSUpc zdViJHt3wJqO(3Qj+nkYFq7m~_aQH4hCT4|_IBgpYj41PMPIv32W)KpQzIOmxWIymT zmJ_PhPakvrj?a4etg5{ltG?t1GP>$*I436RLx24_+gTPwnCyGWc_@4b@AgnRGhyJl zFT+ZAs#7mJk43&Jw`nF^r5BN=rtB5x`*Vaw*Y9xR^leeBf*b_s1#e40+c|EFIChTP zvgFTkyJb{rW7`70rrLQsSt-+1{Z3F=7to`r!p7gn7n<@Fb}M}sTk)J$QH3?T!w8`f z*HxjUyROg>_i(}~fcL!a7H^Q-)#={h%>W=|ghF!P>Y%zDY;DKBeb)VV)OD{plS1C@ zpikuvd9Q=&r*M0we3BIAuX~O4#X2soWc`N!a!W(Q9(DY6Xzx$U)J1PNT|MvnXT5=f z*sjB^4Gl8S^6%eA)o*WjI$wDC(S`=T^#>6F<(YJ3@sWmx8z@B`4%Q#Vz2?`KsH!)e zgxFsQq-}oteRbwdXTrtT25$EWv`F!XhGh*65tJA67yME$>Isx*@plJ*BKv(17~?K? zjIpiH`oxc_>Mh5)?$Tz1`QV3^z1V)%^?heu-@>&FdNhB*uFN{C&J|pfVC$OD0sh># zkv_uv^TD=i^*a!(SN<)$w0yp-sdrFT+R1gZw%%7qsMc-cp_bjc;jHV4T(?&RnWW-O zdl!ZAfV%2k=-Wzl-@AyIJJs%Yu}N?G77(e@&f&)G{rK6o*=Ov)wV<#JL)OEO1bWJZ zG>81y`x+YLI+Q>8H}d|5hN4vs4R7!#?*u_m#k&HQYnt7AF>o(ajBT$n|mXmg-l%(Z-7m|C!EZ|*fm zubciQz{paqjN7C6+5FK5wJop1xo+P4o|=}|FLT}e{rk8U5)u6LOs=InS2erWtLYsf zf`9nKqOaUWnnQctS;M_RC4K-a-QZ9E0AcmI2|T`uzeo71ez>7w)0T#Y^S3rMtmg07 za}5p0w>31}=5J_7e5Iiwp|YW2@$2;Kt%ioQw?UTo8XC5I)X*^SlZFO?Zm_Q>4z%q1 zdn&8Sac&>U?dC%~pX=rziQ`(t2N7}PU-P0?KVk9n)ad7C-%2JE$dHED?W4*5<4?=EsJ8COQFw+{K+(>^C$Q3 zP&+>a6_2Ss)b4rwV|Nmhc@hNHcY%AtB!l<%_~So9q4ZSw$5*ogiNDUSO2U zXpv9kpDSwReS#L$;uhe`RH<*X$EWTS%$qHqsZO8LASZZy>I^>X$?8wFcv0mR(R+|2 z@Cff==}%El?SWP3UZC9Vaon807?<9|ftvOaL2((MIfNAZD?byZg!3!*BG~B-t4M3F zlLKx2US}181<9=pf7(8DKa}DX|AaF~%0WK@_^vAU!x>k`` zD0m^<`+%0FnmYnBzI5&iBt=Uf(4~9PSI&C6RQwgpHn6X$ZV?B-RrDeHFRhd$euuvj z)a&ka0K*N8!7O^Do zok*Ez={+GyUo&k%nMM(%g9YMi0eRzoaTKtR=}Z1MP91mi4r+r$`9b#S{cgV&2qJF8 zuB!H1$7vzK2Sto3;zIyxl^Xx8mcFn178#n{XWu$QwJ0x^XhHR+`mrPd)+T_qs$eal z8Nv>bQ(P})Wq?)!Sn0*JSl$akQ%G&z^P&tTki~r ztPWJ`>{iRH$6(F&je1O1RqD)suf&`OLgP-=V*}(QqW|DzTkw1bHogCcY3}9c#zP@U z*W-`tm6Ug!ukUXBdTl$R@G6cse!b{~{&@NcKK^mz$91jz6WW+pd&2pd=18>0g8f;W z9~rT9r0+?Mo7#<)eNs$ws+?Obb}`YU&H(EodHqR9I}yvL0{b~fs@+=&B}hBv4CG~P z^urbmmYiZJRjT-uR;qSN@rkR1oIFJjK9%1IMdx+HaQBPG=k#A#J$v|Ax~kn534Fi7 zXp#Smvsp(hv{$hwA(R=vg73Xl@vrEt`AaZYj{6nWB%l8QHtzl)8D;M~11jhhj(h3^ zXSu{&4gDbG88z-Vw3OlOhwFemI}Cq9$!|~%;Ly-GoPu}56Wk;2P=p$sp&I2lrzZiG zyk9cIYwNvJ z2T4xt76hl+br92kS4XYzcqQ9=Y>0QN?#*bG(;6K*mqQ}yyH>f@%kR(JxZMhVx7e+& zXO1Ol(eaqVmlOj2QaU!o5*4ZR1;cMb*t~ZR+md|x;9>Y6k8jZ+srl$ML%R_Rec-pM=bKnw%%)KDKX0X2A$SPo%4rM zuV^YAjBFKwTq^3wR-)!&y#y@#32#Nj*ei;mqn5^bn}@b$olmS(Nt|~G-5`h+!W734 z8lzaPj^3%Xz>~+sQWI_b|3Q*e^%lgZ#PIrnX{Es^v6-69LU3w`HkoXC2L_xol}p7> zo<2Ne?J&Krku>ET?DPuDdkLTNF%dehn3e4Fikw#JW5tVm zqLnKB4@sl;`@Ct=bRz4kN)1nBRY30L3iEWLcdX_iB6bPIiQo@X7r>FkuFMOz)vn(E zN7>uJMOAJ8!<}IUXKc_J2L$E34k{>^LuzV5LTbJz_>!7$kd|6nkng1lnKv!zLMY2h zZ%}qK(}XmSmKNNs^rnVoSG#FK_GW59nObT7ziZDKM6>(+9zGt=?0xpxXTPky*4k^Y z7uGL>hA$w-FE5vl1qIp}abosz<9MN&aKMfj#muq0C_gPKmfUTDFV+wggmLQGR%Wt; zDe=*~w(=yr@DhybUG^Y45<=ps=0n!AdJ@hh>4L#>T0126lR zb&_{56!GffvGO<_>Oeyo>X9HPUh@&`#uH>s;JhhT&0H&dtKf}mXKQ3{4}{^QR_$dL zZ|!W4^?RA&a+_HlFvxgNmI(BfN_!GzP2fQ2gthVcN-nbdA^5R@FZ?7iW^l1L6U8f% z{%^&Hbd*_xcY8-!v)$2*n%&Z(CDnBlR7KcCmKHC_aCj$b%fxljPEC!)sAM6%AS>O(G*zrl_jj~<52rsUc&2S2LqwKs!#GhYpl>Z{I zkdNKm3qj1cl-?QIe}@Bd3ROP|y_R*I0XW~Y{uGQbo&=KUo-E5kH}4dcb%FMaKDC)0 z21!CmA?>9a)rnlN?ej6G|=_eWTq%&#r?t5a(Oa+qXyhrC+c7N+bo=!&Cl( zZnDSr8%|of$sJlYR&)9ti;uTN7h2H%Zt@MHN+d-Xb$7vh2y&3BQAue#cqQlUoc&er) zg1g-e8h3dLx(HbPpZ!bzU+w1pai6)2ggf`cLCHN>Yc&O6=OiTsI5?cLzfr(?_UBNB zy8s`vQe+v;C`th~Z9*GU(|T-Rf8xFVd9-6D5#MOaCMLAV7@d^|DDodV38Q*tk)_uhi$dSKXy zu#$DR$WE8nDi1TAUSJ%2T&yRK0RGgfDA6h^eZ9F%d0W7E*7TCQC|j{*WTvGrt~gxG zPlssER!U9-1GAOJr^(;;V7`@wvJ5{=1O%E!9;bOQ_%D=qCC|+M6wJbO8G#n|(PzEo zkFIfgy}b{{za?ewLBFy(Y0Q`Xf~*K;+=LhcwMUTDSN2_z)l6gwU#>x6h4coFhjJ#k zv1>UCNA4ibeFeRIudnbj!obVxtV)d9wIf zXtJ(&kJb#9W7~4kfheNm;yL!<;wr8zdUUW1L74f=V0ls)$mp01OvH~gA2+e+l32SP z>pBBShL7dl!dWlXWq`}aIa#L6@-Oc&!7Pf{Amwh*fV!zTpeug^Cs)H{KBC_^Opg6O z?5-G6D5opjcnudUicplv`549`8N-9@&2aG{k)L*&kK~4fuYti9hm$!tT+EtySmThL z5qw6@9T#9p-VyR#!3W$!757K^z$KN9kmGD3E1q({gqXhO4$M(wFX@=JMIZ~~M#(jQ zp%a!lT7I0tdNigL;+ZjWqF|?@D7R0WXc1e3xvMBLWOmfb{$l2h0Z%V7(KHwl)_7ut ztIGy^rvrCF_nep8pO;Z^aP9rPCGCAccRQl0BW^4oD~48RU6hXnQiNZev0%Hb&EfJ6V50G9*4M9G z3RSSYaiVR^|gV((VEPik&l|x?k`5zr%Cd1z5|Bo&=`MnjB#O zw{DWW3mG#eqj?AfJsGXX*7E9*2G~yDE%!mWvb#ZoEEJW|ANUdY=x#YqOl0FBY}YW) z$~{1Q9cbh|e^qn$UQOL*^*!=nTU&-AW@C6FCRsK7S)!6YO%7TW!f0inj)gi+W{vY@ z)6fOP%()kH0v|m0V&>o{@Lu_l08TiYd>J@B<3731H6$A^-G`SD4*NcUa?p)Q#ZH|a zn@H1vh9Iz>4(|1gxo|poStNz?#hMxN3jCgZKQI(;t(wt+#fY^~em_=4Opt<<{{xG* z?taCJAX1Rq%>i2nXHatm9QB_-tH2()D$+JQwlPfU63JV3fe7w3WKLX0#YOFU=3D1hJ8Dg>6Smczgvj*A5;=~}ZK(=GxyDk7hL;Dws zN|r4|BhJu?g{T?wlt<*aYp^b`4IhN3h<2wH*TKim?l0j)v+@CKwLBO32qqF1l1Cmv zcP*8GjFk*E@nONZfM|LUF=IT%@eouB7s+eI+PQ}$A0#dMPd@u!(Sx*nuq%2VfWtc0 zS&#?tvn1?kxj@B%>@Wx!7s+~Y2JD?mp{V;m>S9@Tem-p786&hWuKFCL>3Xr0=NJwkuMp!$3{-sblO6%OKjL4|{i@l3KG1r6dw&DYyunm5Wxl> z6Wx?DSWBX;WuO7j7JAKyHjgX=V!gtihwH`;_(}P=D?Zc&TC-dp?n-E!1f=RsRQluL zCgIe*0J72c4NsR9$R9?zvBo8Utch%U>>BDYtPYg{r2VD`g56i>B!%;M;gIq2PHBc2^rpXblvz?ZJUcT_X?Tx0XFG!*@CcJB*U;&;rl8A!VsA?8l@(P}@x5ko<@_DrC z*Nqqu5e#wEHE_T)ui>!4vg*FlKeU;(Nk-@>Yr1kCj&hd#flYh)lVDL&Dr8yA!VSS$ z2z15T%BujnJVVPWgb}HsLd>pAX)NO<+4mTg-vPy@it)jE%W^8*-(#X4!TW$J^uVfr85pC;onSiw-a9b|BG4#!W(3To9Xr9e04=_K&3>f6E##v`Z^KNC z_bC&oHaa%Wta}?Y=NjFHMl_DgD&@(4mh9tY7^XdoXg1ZA0!E}NpzvzCSS7#Zx}jlF zRQ*dngjv9LFqXEwE3cAtbI30FLtbpH-j~VMsiEZd_t8OKGFc@32ZEs*Czy%C59C>5 zn~8kh(JjKN*LTYo@Vc^x(UUoTkDSOGsAYR0Hs;r}QPNN8cjz#M9EGh)-N$f5QN0%n zvX3ghkYl5|Ss!NT z=!1*raShde!E;3~9fJrRN2@guSBub{KJ$Ey3~%t@E58O@XB-F62XU8Uj8ZhByi%4)AIE;M-Mav*uS?M zN3}1>*f1VOF=!BzSzOS+#R|R z#g(J5mHG)x9X7W=gMT_pZGXma3S|2(@Fp-TEY^Dv@MkC5`x`Lqx?kk!*FvO}c2?dd zHl_Drba?zPQ_+ZX0PbqaJ||xbyY4v$%;TmZ=OMhY;1}-h;qcqj26~O>{J`3yexzzO^a(6#1^OZfaR85 z$+7kH(H{}bRa;8%9+8U4VMgc{+#yG?K_bA`%(h-uxissZ?xR~gY6oG;$Z{Tj=T@o+ zS2{&(VZ>`?^$upSP%~7j&!4mUUe3aMqORL;EUR==LUo1623Hg+(vQ-cD7~=w@|!3= zKclD+rxrpajZ63U(f!%s2s710N$4T$=}-^PFc%KZa^p&_^+||AoXQ}WcC+-9>e?c7 zUFDsg;4wu@nh~xfQlUMdh<0Z%A+$*vnBQ8pT6;`=7IhULLH_ z`9{W{voa~UsnT0ik7`6+!*Cj|#0wzs(nY7zO+006!Cx972D}Bw$l?*<-gEXyAMN+4 z9iS`^7hgHoD_MeVWrDT7UAjep4Bqg`US$}Bw2TDf2)}UvbV$ zPKs=yv}w!qj-iQ{UkJ>Zn`wNM33Uwi)e1}V7C;sOs&ApdAPygA$t|xDzKdC+jy`2L zO62>LR}mrv?T96|dqWR~L@L1+I4M2Pfaj%1j0-}CL@HXaf8E4t2x%7Z1Y}eDD5X;r z3mO@k_)C)-zBD5Wb90w982oXa%Aypu!QLLFEC#MmZK-sI7&y13@}g@J%CT|-beTtb z5~+W*5)c-B$P)QZ+_?@hAv}=#qLp3_#x8a;zK`*ty0$UOPzhlpT8s8(wpKdPt{5c& zfg?`GC~-hD-d30b9GkaNItv{?J5~Ll`y6~)bPtsw7u9~+N*OCnX;jH1F)8760PZ}B z^9~@e>22Vu$F)J+j+~>O$dXtkN195xu}Yj{99q+aj0&ibY=~7>3kD6{y3W6{LXZX_ zuF1$m*wWIOb~`YIybwW?us%gSZo7cUzf;9gkdw#uWOM z71Di7XQ0p-r!1GI2TPPnaO(P7oH7g_$b1l!GOvx2X8kt5YNL$iFQ>Ls9(VCZ%7%u; zQSSHP*1u|}OcpMQLegIr9x_g1(1CVAyb=rF1`FercQGmH2}%PC7;?jc4d2`-j8Xy` z0~N6LN-=<@s=YGPQr0o5AkHp-6Fp7a3D-+m9h4Z<1ZEQI6&(~0|L%Zw0Ck>3+{(MrCLt#=k;`jY^<1*abIr?F_&Yhb+Ygdj+lzM|`->%3!v#*w;mY7LSnl zfPKCRlQV`gZ&G*{RuH`Hxk*WMJz%x|1@q!f$}v{jIobog2$17uKu>@M+>B)b-(fdn zk>C{NW?lzo?ahjYqNbFpU>6L$nwImMBRan6_4M_~tUZ}d^1 zkPN)TguFK{9<_iO(HCFf&CqQCZ@@R=qx!b?SDf6IqT3PTSs$pl!QXWpsC2%@M#J($ zy<{N3x3T;h^Egm>%$0-wF|Kt{Q3pFrxbXR=B-F5$4^m=+gGXgEfzc`l0i*SxT71%s z9IPy`zCRQ!Ci0$?9Jyl6NX;;7!Ir(eHbY@B7p>fpsU(T&ZU{O}u1<&4t#UmiUNOTI zj}Rx=Ncxu?UowK@vJF#`Fsuc`lzsrOPlqX=gzBjrjwfg6^l(fcwss>x3bxR+5e)^* z5hInQVxC5U)G+?XIr64RtvCy!wv5q=Q{;tF?HF5ZNpDEr^iUqe3IS-qmX22T!T@o` z80B4R6Q{&bwE{_@hyaptr!pCKkwW-d&A(>_7kka~0LP563foCnj8(cJY=}Szl{ZI4 zQp`A|Qhf8epp*JDFC1TV0Q|qD>A;kaXMBb0Ct9QGGbn6;bII2Q}(VfXrSM(1OS6(?gPp>sU`D^ z%pNpGs}MjxlB<-Uj;IIGC7j1R2&#nxggG&MTyQ#gifS^Pn#PPxpk(pnjvM) zETx|XbG1#wqDy9DVQitIB-W-?PTsv3Mr7Nhsz)|SxFgB>x2!0#gRO3K- z=X_-Z&Z5W9#~`kO3VECl7Wf78l?Mckl`sITO2I50qv$i_eMkvLWf)FUYBT~*J*4cC zY-ilmEXQa~84Hvy=*5x+%23f$xRsJ2_R}ANWT|d}B2$;KfVsf4@PiS=nyCxHY=BlQ zRPLj+7$|cGq5#R`9#Q6HFTe~X;G5hACd3P`NR6u3V7n|btajBK$% zU8+R4;-eTQXajIDXVM-Qcl8HKT?#C^kFu94zV^%(@o^)UV)Do(IFAqPIgkH1uPwyR z07h_cBcTVrVVP2nunyy&0Qb~*C$W@@o&XTtKs)gS{#TIll>~rjmd*={A^AxqLwdrT z@g!y#WsCw4^SS{LD&;X(P`(`a^#+oj0w9MTE(g(UoP|*7R}?6`2co3q1z1xJ`BeqL z;|;0cH;=NvgkR1&o({>vV+DwkIoKWjT*oM zuEEsJTP;XL*?Am+1|EW@VlH6(;eMb@iCvk2u<#kS=Iq=b=~1|ecea%&k@zj@ zttk_mDYT0{AvALr7eeExbhW6o?F(Xagm>TtgAp|44@E5I3oj^zVer*a@K46D$d4qc zsF}|^^-pEA&A%oDB>*BuB>%W7{k)GltXKTz(pMBYOfXx_Ga$5E68tKjayNIHdp9V$ z^9t^T0kV`XZV|)b{S|s6S#KzC?gJD%p!h&lECL1M)O17?HU)18K-&2R(;hQ@D>{vy zK4Xe`sWO%4kgBcZiQOh}Cw@b_d8tpQ!1*R_vu>NRx(SLDRN{rQAPLx8$)jbWWHHw@ z`(L245Ot^W;QtG&M^re|-0`k54x&{I2N=sNh>`>Ei$VPC*GPnJ`2~J$a&Cc={`B{O z>M*tME8Pq(%)rA$PatUYhyN}ERNoH-7n%Qo(#`P#2GSFR;urbkJC0U&(qhQ78*~%^ zv>S_@2P76}dQIY}dbi>h>6puD6g#?GnJI+OAqfu;?OGGnB{p%rgfED8m@BLCUDrQD zX{vSOu&wR@I9rSaf^NUVBT;`)`9yTM1!doZ4fv5yK_btXWB!B2;&IXE3_a%2&z0kL zxXh@k!R)OgZ!Lsrub5S}N_1G%dVGKhUL9{*@yCsMHHc8ZR{BdDDEqWB3QlvCsnSMP z*GrUM3*I&bZ{@*TMez1|@V1$}-zqb0TOg)-H>NcrQz#zl@(rkATl7Bt>pbq ziMN?P`l6lM0ru|)zQ=54e1k~}yosol+>Y)1@hOz?5R4W)b&6A{qA_LWhi@XftuhG~ z?I^QI+CjCa6&ywxaAThKJ!X9;KZZ!#k9D5)JvOFq^B20o0$hl@pqA$*c^I~QX{Qai zgV+a84;d$cS6~)?TIosU7oj=iIRV-&YACN_fAF*6bfxm7(uQW8z{zaRNhOKS@UL>b zNcwxIEaMcmJiDm=l+w-io{yT9dQ>W%)y!S;8pu!D)2K7&1RD3gXf%yGsiaTd8JhfW%vxhs;lr!ad#_6GqtibsiC5HwNDe1}BMVz& zfOfo%fR|znvg(vJ(nmZ7*p_WT(6LgCJ0R(mI;E$h8ns?enID0{xlpI1*bYFRrm8B9 zuE#?DI0z|Os_ixTjEhK4ZEhT&oa_g|#(PjF5Q8=qV9 zQO{YWzwL;R)JfrfT5uMt^eF3VT3}Jl?#iprf*t&VHDj^kKPT34?m29ckI~U{2+p#B zvugPFAcUHLj26o}uQ>t~v})o+&K7WlqKhwN5 zZJO-bo` z(kjEO6%WoSD;;vfciKuvSbJ^ZvR7RN7WYrbLXwhU#R4$tMh1-3*KplkvkquI;8kVE8Z^(#u61Ke4gq`Q zcvUw%fk}}neAbZ%sM4!?yw9W12uwr>oJ#3{SJjL%E8Atw(+gIbH>EspFOs)~8Y`_u zL;|(9_ob^U`6uPKKqW6rdW~{@YP7UTOh4(RAOKmrK`1u(0668r+#3E}!L=v4nAS3E7|=6P z<0)qc>>@H0jL>FSm#N~=Ia2M+esDOom5L(O_~NV^L5QN%1o&}4C5S7s+HNn2R1?Gx zM42y&Ql}t*P;N`L6Nq71ON{i63plK+iBe-g7DfI}&hJd!Q4PBxchlt1FVMT(XneCO zc>5Pumq;~x;NtsT%8XItLCtUjF(_&S!;CMTh%1zV4SHIP>XF_HmUusS`yhDR9V}lH zgC_5x`qp??Zv}0pgVFGw)4i1%KwzPUT-ROn9ctL(+PMc(uXNO7OVI(s)|*6)85u- z&TfTB{7EILyQ?Xb)qkZVmTX5f zp_H~DvYxi;Qb!aXc*zTYptPkez_%qGZL22QqNC{kEU+h|>p-*u?bPnnzYV|-_!0~s zmanaK6irZ673!Wx+o_3A>#R*wV@rzKc&<29^7yt#q7~Zf~XASn0M_x~-MwjZIfv?W}ZYdgHBhXnGT@G;Un}*6Z3^8KL>@ zV5LLzn`os&{YbLXp?-9v?Fm>sHvq|M;4DtT>RRvWv%8o->x8m`O2kp&J)j?jgQDDm zg$RhDgTXsC4B!C}9KF5jv?WK;YkM8oN3>V%wi_EKI*UY0I?^7~)rDWi9^xzvff72X z2}W0ZrZFwP>8f-$%I%;|v30k=sYet&H8irFz>rWj;7JU&q?+yJvJ%xKTTiQKO5>ub zT(p~U%T=}ax+bDZyzSp+V z;FcIp*37zq+Qx3{htW{%?I@)yXik4~d{=d-O&VZs?56f};+(%~lZt@%X=+ZmG|0@q zP4!6`C$D9s-U1e#%PAE|~# zOPS`*>FU@fwqa40!>d{9ENM8sG)sLIzSc8ms}D#cA=y>q9C6@*!Aw1&MVHJ`3vs4W zG)L_xLEmUD=tA8bH3_m=WiF~7-H-)~jkzFQV@#CUEQuPLz&H@Q->muSR0l%sRV-FJ zn-?BYVbWOcTJ+Y(Rc9DHhVXCFpHMGIeaM@y z$J4l)7zmNf%qP`B5)Pro^MGX7Y1?u&3tBg=3e@5F)QkcU_&9S(f%>jwn}F`#7uDLF z{C9P&gcIW`hZbwLDN@_m;KOr3u?i(js1*0ov|`UcA;GDI{z~~ud@`HI0-}l%b%oTI zyai}*4yjJ*E?yh)W+|yc^lCh#9^>{)C#;oJ59P~#oUGqgtc-B5NOYJWNHd6kQ# zm#St^($SPMAA{j%%!}#>FPCkH<;83M4qWg|Qx6@m!WY%)sP5v6>LPSy;aWA!M$RWd zq-wUb@R;lV3APny#h5kCT)s|~rB-(X1XEdrEPX{aiFG&^D-nFdU`=>^_wGm<8qPSf|yU+P_J@lI`j&*L2h@ z#2s{CDLZJ`t}b=WXvj0(RNq3wkG_d|o;g6LIk>@9e+pK(tC-Olm3t&p}s?_gr z98`1|kdpT=m5+mXOkig11u}XDqT{>?5E{7G0$~N-1s{WczN_|*XzXKrHdVZD z7ozdlV6NV!_HV^A(*_;jnVE_UGIP=IIP>BzteGHCYB)s)(~}bo_4p(2WBDPdL128b=#s}2$d8g8l|1jC@Zz34O!Cikf< z^Ub^z2SwJMtP*(Zm}752KrXWt>= z8k2jLv2l7m9ry&x3*zxQAhN=rvBB~jL=E%d(;xW{(Vl}Up#j;Ss+&d6pp9`T5}INE zQMXxXxYO=N8J~e84IENeIUWY=!04hV9GZ`Z)N+nAe;DJto>D&pj#+Om{7ik3*N^eJ zdR!8~7)wLm0XXa!+sbVQjxrR-ncib+nB-d60EbEq-dYdwnaUn3@|`W9ic_nW3JV%5 zC{A4pJf;S|RHxg$kA&U>SA&1x_R|-zpz<4aG%ff9%=hxQRHvErEoKLm7JR36qw<5u zUM)kjzWQ)8rz>QawVonQfM4B>r{=g5D(pFN)VBextvso=aV-vghfbfw7T_@|dsXw9 zQ%|Y8nn+8iYN{6N_#28?v?J>bRyNL3ME=r-d@BD%eT>$g#9S8cbU2HXaD*Dj@Pjoz z3kZLL%Fe1Yaaw^}FUo3-HBh*U)tS$M>v1hdEsPclAe#X9z3Nw0c0Fa~{hjlAxeBdh zQLsqDZz%G#l~-&I`Ar=ZhNA?5PBvTwrd-MN0f*CnsC^Kh)^SN)>>{i9DzoSkNQXra z4r~eYt*q0gVmXhIw0P+mGhfnr*%2NVNO?GbPayQ9aFkeWt_;_X*=%c~if_+uNu{i1 zu*#+FlKx?iZ>m9{{5;iPk19&VJ7&PGO?JA<@YNt>6As;nhQFPcTNHdn$9RiKza1ppd6P@(IkP;Dk^`$Urd$XkZG4@dEH?$mSooV>BcWlxtOx+oBgOrJ}SO#I8ZD^~l0Dehtr%iG(PGn8y-a&WM zmF=`TJgSJ-o+GEK#gu^diBrcoGdDp)tf&nQ&B*VdT`xhPTac)2cD)wLCehcdB+c&H zbY%r&l8?@;{De-E#IxqbOxjJyb zFr*nZ@FEF;JkDQk(E0&iLEi3LS?SS*fMqi!chX{Ub}V>F*el0ilZ@X&{@#X{CU{K8 zRK!t;-7`Ka_Nm4V(*z!XAOEo+j*Q}`_M(} zBSIUpDxX0I5}`p**+nbF20OE>h68YOO;_zn_)#_6chgLX#m?Qe$02MMlp^p3Ji>Dj zs_UQ*r)b4Fy@8gx!zQV^hh}%Yjpo7P>kG))guPB(4{a61(IBbt6LhoYbTJ{}vr&Um zyJ#AfKMOm?^1BSk2nIr(y6$Ez&5nIK_>0Yy&`tAD^=#E{p6{hqO4zFlhN?PUTjk{j zgpOGGcM~dlDO{t3Jl% zM>OR83EC%K9)6Zc^9F~}+HSggB8F*CaA;Rg)Y{Otbj@Q{Pt^K=N>Efb5Y2~Tsh11@ zU0s^3jh6OOZMOCE7?UShx7*;BNM5@ha- znW5ewc#*Vbt>Hv`sJu%pj<08u!)qK6+db;L1g6JW%g(J(v9nXav{ z<$CD;A3d#s;qc14p{5so>x$m`K(ObakI*iAT?a?>G&C5d=AfOQh`NeP;d_ijLz$jj ztv{5A1pMX0{XFG7sP(tD1GS^vvBl-%00_r$?vQ8qgXx*?cb3f5V#FIR=%Ru{`#IVU z$&OfAmH!R{Nt&sZN}rN-Q$nspCp(~)D2U#P{~{%mQ(`~%hQ zhCHq^7QR0MbHHI8UZgDuF?j3zOP^W4-mQ zb^p$~pRn%VTlbS@@*1t14UL-iyf)V+oic07w4M&>w5hzTJr^e0?VhOu=iI%(@`qTAI|t zZRWkEotGdOWK81v39aUDfRuIs*4b9BCD{dOi$B7U(7Ml*0w?gp>{0aN3X^$HVs6Dpymb`Hd5 z&o)rZbCkOsVxYPYpdfypf5$@jD6%|<>`vQnQM7+rv(~h0yOv>vO*qgO4wwUPYLQkt z_k}1pT-t`cOU|2`+xB}DJ@TgJw_Sj6?tOb}+r=n)`%SI2?T;w>;sZO*)wTmcUiiQs zgCia9TTHX5>`k(_-Q)rQ(Ry}Bs%9lROz0%qpCqvhDW zO;L`OEtu!w*@4mRyV?g4*CQJX!pf?6U+Y=&o>t>^|GD&g+U5ujAlOja%X;5#VMUZ zAMS&DDbK$F+buY=GlEcm`fu$J;`flTAA?)DPva14{JUg7=&|^z!8=a+elT89Z~_d9 z-;yrw*P@|m67`YBvF_48(k9trTGCTzZ7t0mA88pj#AuHA7(?G0DuEclSRQ&H=#MdT za`3lKekbhaIp2j&T-OzsDkh57egxL2@*pO)=3_KLC+QRI1AJ!BC)y+me5^$lXF>D= zWtabGy{Pb0Fg$U=7azkjs(arKVpI%FJML30jY>bpe+@|~KKS*F`8@sDAsoAeTUR(^T2o7hc;mS+!UBbPM_y;nw2ND$83<7qFfx+Jp{pc&JWsdsVnvP z5fdc74+8%q+8%66Ngc4e*rs!=y1VPN%`F<6UEGAxzo{jCam3w{((1wLc0+?KZLjW> zU60=OpsIRI!*jIkCvB7WW;|!XEE52px}J#Ut93I{uF6imDt!y0Yiq;3y{^hmBgYxc zW%r*oS+F&|xmZssJ;NI-WYWPiS{FJKdfY$wc=9iJJmL% zIE$w-zaVeiSv+09zjpJ}9cQ)vbcB=oIXp-^YkhQ7u-5W(+En;+)npg<>rQSdl)TvJ z@H~LA59OZ6Vih;2T%Ol<*dQ5O_&b(^pwc#~bwV{SP=vL&<$|_@OJ3Aol=`fc^xic3 z4{TV1KQCPVS$fIJ{TZdbHvK*rYw6{v7QZzKqR-?oJ-QY10KET-!!;5Y8WxQ32GwRL zy7i&?VJO{)o(a=?icr!~K;JGOa!!Zo-9(Nrl#^<=aw0=HwRSz4*4p(pqM+O;J6M_0 zC?}c*JM=baSFS^RnBO%^9eR?zBg2%AhH)c92(q!YZYYm+MTBW zvW;yS6h`aNoGWqb%ag~Ule}~UfwHQ-3HR~HXPVUu7mo?&O+a26CGXRHV2`@slu)M%)M^CFr4=KbQwJV37_7{R^5``b|PSGAX1M3yFVaO z?*wfcegv-i6;2(b&v3JS+NdCX=hGue-yG+lR+0Mk)F)E+&@BFME&q3r|FcKozb^RC z92})Xz@OAwe{4}((EqDPg+-G0THS5;|M5Kj8qcRSdOzVB&l}ah=(_g*yTElFuJOF_ z2NJLGywL})OZuPBX@6_IX?kOjXk7OV|MOiOT!o%ft5{w8%W9HC#Td-+#{k{9i8qFx z)BOKcO_xxyzo@2b=sA7%zpCjLD)txEbPqkJ9x{+XH1$yQ4_!Bha?J=;7hI80$nv`5nsYsReCbYGY)C7QkfFJ|g-x(D$U&E$6ayHcxLtcqCO8)w3TS!V!* ztD6L1fHl-ML1&5245Wlex>-<2vN}QE!m^6?`pfvjukGQd2;rC`67^$JNAq+dUUi&} zf_P(PJ>0=o=0I3-WIPV`(>h`mJxBGaKuI|r^+FIn=>~l<$83HL^sn>=eXrD$DhTSK zd7bn$6vaV8G>*qk=S4sObR2dC7dq+vU476*o;P=K?Mq-j0&tVx5&j*#I4B6{kuIV8 zgvWi0lW)iVC7^qxHfB`-ACmeDhZdA|qrL;RvlJX3?AjS@RY#i9S&zf52scMZAcm%t z`wiTDAMC8>1zW->O-C5`E_xRBQ~SDLc&~U1sno9e^NkA6a`iP=+cocG=;YJtDpFERgpLI4`feNl$@a(2m{oxl+0?ZlE3AbX`iJ%qie+>$;&& zp#R-5;I~4~r9Y1N)fhv#7W=T36T@2616@idZ-oN`a00rGH9f@J(#?8esC{WS>$C7% z48nTacQYW#I=PX1qK61#*i#=w-!+Nz2nVMO7wZuR6&0sYdQY?>DJ3+W@f2tciGbi^ zm{b*|U?@c^;MAo(6pvTG;(_)>ik<}4r{YG)tpce!b1<2==$)xDRS)1dz+z%BYZHc7 z>V+!$P0(cf ztjCf<6`MeoD%11?)FO_kJSDolBwg=kr<4H##naN8B=poWvx;_-ud2hwK6OTu6 zsy+I>`qt3sN7JrbF^GMrM{kTPEYADuzLLSvXRqsx{|bAf+TiWwbfmAIAl8npxN0gpCO`m!z-{_!j7aVs9Jci~5T{V<`(gao zQ~Q443wST+Bcn}g9}b@v_QR@$oV`Dig+&LRiO&199YC7am<)J;P0D z{l#KK`9##Wu|EKNJ$=fz07>`2a>z44eD%r-#mSkd3ANpXtDgnO&~zC9C<)Lj1N7bz z{jFR^2oSTq2GQgB=M9`-4b*ec$g+W0gLtD84Bx5;>XD(&9eElf=oyJKkHWVhVD}8d zqg$xne!Y*n57IX{cvfM5RSpSl+J+`}jJl3jjlsGJbn@9?{by+aCEl=2>iB|NcK=Y(KWE4lVJK` z-Z@l26QBoyi5E1rmt^QugKy)cGDE;gQHH+BHK^gW0h#(l2lF?*N$QFKi={<4w5-n5 zo#@`t>1#NOG%^jfx6n8UpzvHt*0Fqt?F{%D8wzWC4T+sIn!+&nX zw}3)`_v@wzH#yDaghxQ593-N0JqVBIW++4E-3r*UBwUsZP_0yMc}s%AEj|Qu;Q`cBaqJJq|t^f>*;cF%VxLYLTM6jx_)E#>JR{ zJM}8A;MnF*1KgES*)%=Q%TIaA5^?bmohONfpru1G-*wYKCyoR|YzFSdx__7Qq93*Alo6_((los4!sVmVQEXa z4V!f*2E6(`%vDcEk{2n1ozFU<6)dMrrZxt-f6i4d1vP8ogIjv zb*bITDktDG7v!0{Z4)N3RFezx-;qW>sDI>Qo{>=)bWdJkcj?V+==a;rU}N?>R2iqv z)R#)b%=(#V3(latvw?j3P^%V(M*T0eZbP2FIBzMu1ZC}2v%wk-X9ftEXb$KCip>$E zY2+M13k3gMI!E7tCqw3f)Q{lh09rIx?{3kal6mN+K=_H2HxJu_kqzkc#5~aEf1Ad9 z&;lrZiG}plLtw@&t^zzRXzs&$HB`Z}7wC&HfVB(s&5nO#5D<@P4jP>G5)31DEYu?- zMu)0pQWVsKsavSKB}6q`D7ZO6MrA+Lw(}kVoBnTF@`yf^>SpSCap5TFGc1P-?ySW? zNb({*%V>nc;Zi8K%m;Kn6LNpeEY|T{woJ z=gztMZ8>w$uP=ZWdp~zR8R3{g~o(O4WIVY!s+0P`_N}g!PcIp z1J44XrYzHw93P09a_69?yk!8O?BJ)Wmw~bQfPP(uMw}+)34N|{SL4Y>oxDPMh9-sb z>5V6JR`3ujO@2~v_ySl9`S*G{{UqRbJsHdOe#-w`?v(v+P~E(JAVl+)LzYtbGNdJ| zmt#flqK(V-Xje8G&1)U^@LRtQi{2CO3Tp2FMK78QF8VB@E-ZiPU&XK_wvd&!arr!<+0{*GmQ zH&y&ypDQ2?@s3@FPr8TF3q`Gv5(_CU%$^HDCmE-Csdly$U0hgbH(2qCQ5>T?7OY9Q zHy#f-u%8Iu8ih}Q4XG={va!^#GLisQauI;hYByBuV7pcXOfZE`7h#(L{l64UY~X2q zRj3RY=`8$a9#%9Jhmc--Y;oNyAXLRc1~s@1E-S_kc^daX92-*F3T%9Tq^cDdt{*94 zr9L*QvEM2tk39SL(!!MxfU!T^m3lj{@}I86#=&YJHdtLS)L}0G%e_zKPU+l|IzF7SS!46!U=b-+o%QN`I1d zA_ZUc2_8R%NSh~qxO7SS@zNz7R~KA&;+l=?d0hK&{f_ItpDtbU{(R|Dk6$ibdIZ-y zxHg}?bm=s%kIx}GVYeVqMpT|;8b=yZVmg58PDpIf=d;u zmS(|o`f;1^s-e;Df#-2nD4*u91q`n@*R0i#BNCpOzfSMTCgD5Rqj5QObiF>&HanW0`gd4M zVW2FwAS4w4Vsl>AIT{v%@Ima*9LAe<7lEWb8}t#b98}NKh9HW4uxHELpv$f~)+f(W z{T4metlWUL2R9kXM*+g+h&NcAx4>TV8X#z1FmLr&U_UZmgS242326sZD?6CUuj|)K zRt)i~@eU2DiP@X=Sl7d$?wCuEWc8D>EqXuKg2tcxoK|lDeGPt|>fX=;u16X_$Jx&t z*o9_n)mJ#U{qVvHKNxgjtA1F}0Vs8N!0+VT?r$c1<(6#2HW{u`wqc;)M`9ZwyaVL| zF~FW$Uv4$Bela50*R2G$4{Qe&TJ)EbK8muEp;MCcCe|-bY~O^C=klH&f(2;S>b-54 zk@t2&evo74zpcY*EN1y_>_zJ;^&DX&F0`dE?mWeLW^R@KVw1*ZM@-a}#QqFi7t|2&|dCi)aBA~bUiM})pT8*M` zP6QlpWaZ7*;RzHjFc^i06;ol4jj?h z!vcUZ(N%oq^Sq+~Md-XA)ycLZnqG_2T2j^*y2sUUGD6Y>@T)n9@9)#NXF_1#0Ejrqa zYJFg412uXVh4Yv{PQ%52-0x@bsdU`KDYGh)MJ_YgwZxVheKL(ZDpr9}E95^zYQa*j zC*0sO;W(H<41>M6ay};GbsVVn{{l-{@m$ z-7(#5ZuZ5o&Gt>C7%F$c7|#{!r+uvf^i*p0`Hf>9h-h1@(aG# z8RBpWIc$ zD)v$+pN9OPPjUUTA-VGhh}2%D**{`h*9qL({*}8Nslu&hMrzk+iRhGdgCW>pV;oL1!_q6S;$7ye+Cq8 zq9s4;54g%v&{_cACO*@1Mo+T2Dy+A~ipLcF0AE>IXY~xA*NU^K&YF(Qb9!Pc?$WhZ z*6VP`ilV}02(N?D&S%rtr@GtT8UBR!vC%#^KNzbDGe{h}eL#5|~MlIfbxy6)l z2_;zRhx+g@@%_qvcKgazMjmuJ#eNmmKyHQ$)|#l?1M`SFDc0G@(+p7CIe{3(qNcLt zOx0{gnz1(oELQ>1zED2Z+Ke9;?GGidD)!M|A-Eb{MQ@UKDP`+YUz4{y9EBrF9Mi0EHWmxjwaOv8Yv=fd|W*7~LV)5G>RVP#o8x zYZQuc8a1IH)qi8R@>`*1qPvWYAiFZjbvV>MI_fgmI9F+EJRtp-3Yr?y0ee z=U3Jq={D91ga%o_9nf?P9Cg@TM;a=FpA_EzrTQR}PKq$Pw>pYPEKOy6#gP5QmDLq~ zfF5O?HsAnb30hblVT^ViYbfGvW(;@LG$aKJxwM%P$$Fh34m8148!BMdHivO{t1ppm z{K?~?=TziHS94(RZuFCcWM(K2eGhCY^I90)1)7y8GtZAz*1~XF=_-d4++1~-v&3hB zB%A2lSQdPj)nmQwhyuu>zb%d4(pP4FOJj4GgZW4og1`dZ4{mL+9+o(}eXO-1BT`{m zYkV9k(yh_dZ(td1Y(gqoHsW00TJ1bT<7MNJgi}k!=!u89iqTCVsisuaJ|Z4GgXAnO zOah1~2J}fymue(RuJ0P&PSuQ0@S0aQ7-QA1VCGae+#MN7hj>MSyBmQ%vrbHpFVmk2 z-FQ))|A+;KM_eTIS~z9Dj#0`pj6Q0mV8dE_TxQtCPwvn=jCc^52}@)C{7s8pQs^rVZ4#wZKt8^5tI zCCONer$UN>BWoBEbz}%@ltWoJ7^jedgDi-cIvK(_RwuMR*idsrCu0?xy!A~s26<0n z9+*OgxSJd*OEy^Fzbe^i&O5aOUCh0oq!`b+e#EOm5-SaAf*zgIVh@C3d0X!?;4}(3St5pnvH?-5>73ijCh%q^$-kLXNs%6S=hAiYfuVrC(gX~!z5#tK)tcDNBN+zv+rL@zKK8vS4>P8>`aLv>Xf(sa z1*C(GFB@ijV7nMi_YOCnhKm+nn^bxW%cMpa(`}cc>4_1>gZR$H5r!t%V#ezXev@!< z6+J0=q`{g2BS#t&#X^M}=^voKocBYt3=;=zeB5^!8NmfuoIV24SVkHPxW+q-QP#3B zr;b9Fi^E+3ML}J<=$TeN6p_Xl(NR3oyuO^)2d!QEMyQ6=-41U`gU1NQ0R$DuVJ~J^ zj*bPOiv`xXYlsa@z;_tEv0SL( z__fix;_;Kvrr`KJGtOX}nI+?m&VRZ3Yz?J98*daxaR($+(he7Ys2eUZkrPo-?F8Ts zsIpHqrT~PdO$4=AL#?vFGr&pSCopU*Z^sUM;`|}^q*AsKbhyojU_3DmXq!^AL8QcL z!6wIClZ}>2VI&O$sV3Dxv9vVI z1{oIs%UqRfWbsx-WJk_4`k)=sJQN9h1$>s#F9HW3GtuW9S~Jsl5e3s{89xHKC(jln z4Mh_zvQw0JJrp))i%}3g$(v`y(C+0PcgY-Mi>nD56hyHH@_|vo0L*7tt~FpdJjeJh zNF`yRHnN%B#VdguEt1BRhYaR{ zybl{DGWR@eOhl$2g=q_n1Zy}e#;P-IE>$7bhjOmaa{7KaX#4BSjrd* zp;Xdhv9fzC1_K2#*2d}=?_60s?rUlb!4$I^)HuU(}p(R z{TP6AJ#}3I3${sa02El>qiRw`R!Dg472A-R0WVC5O7(0DST@dT~@NOR!} z%<2UBZgcQjBO?qwSo1Pk4ik*vOlLZr=Bah)8muvb^L-X4>8Jj{e>LZDAf&Iy@I?n7 zv0XSVAA|qKtp{R^5xK=V-(jyb5kQtQ4Ck(U*JEGjHkDVwCc=6{RGGH{3^gKYZZPgc z=OQ*5S_?jt;uEzHXNvQjTQ(Z41$a6s{~?Y>yV0mY+Ywq0nm^>-1ayF5-vm?)8dQz} z66%4V0WevkoH4MX8&{6Df+powpoiELRX|c93gLMCd-UaSg|S>{tTJiyQ>G&Vz6M@L zdvmDvbwS1oHXG+`tz#O+(ktC!6h_2aQ^t$O(n-yD1K*O(yWarog!kufH691?kxT>r z0+i4UQ^YpR7O&sd@Vn)RHq*8lv$%zCY&SMbsyXdVta5ax>MbK^_!?TxmkA|rnas)^ z#=J05PYb9-!qz6E5?rX2QFPD-6Ok%xztDg^|1w?;hpEf#Jz`71<|9;|1)SZ5Qm3nn@7l;a||Q}!rWs<=LkO@U$zCeB#>ijFm7<%TPqe{YAxu?dRka(oD_hAn26QkSQ1|v zd0{*m-xx326&`(_Z{Ba*h>N9#%;IoUG4kI7ZvmdZ!6*k#8VA{&m%CZ4e{DDQ(?%ZD zOik>rXF8-d!Ty&wjRyBNKMLj{I3F@I&KawL7ns?NF3wp7EV*6{U)jR{V54IXW248n zveZ8U9}@m@%QK_xrd#rZ(KutaviY&~gnQgD|66XUZNt|o#^Yb!u%W$;vhRx4C~XV8 zR&kFaD18n@DQWk+!4Zt~yG@VRzt&}I7en{AXdY*N*4qE~COqJNKS-*%-S2%Z`McY0j-h`nv?FH-oWPdOf%Ma3Gk~RPu%j-# z%@5qz(~KJ6f1b_Nl5h5;(rbqhdNN}f_AVC&`C}w#91r#u zE887ZRRi4|>}SFv4e`S)lZFflrcB-i4)N>Asu?4(PZ0_hQ0N-|oNO z2G!wTGyJho0FKJ^{|>ck?=U~Bg$@~p5$j30!~D_E%3L{wb0$#py`KX1K4&xYM5mwRFK1JAH7G zo{@|emEY;_j-fblr~f_&&+Y%~>r3Ecyt@BAlNmB(l|&L*OrB*V6OlwLwbewZy`m^u z%1DA#Hpy68Yl?1Y6Ddclm{^L6iWZOBO5fUwR=U!v@^*h)MXTHUqyFFX+!=}V_xtB# z-21)Dx#ym{-{;Fn z4p|t&1|Gv6Cp&RM)9@K8e6kz(3==+3#y<{YiqM>y1UDT&lE?GsH9dtpu5NU!vIBaDOa&kjY$&trPIFht1SH|K*-<~UfWx-YY z%17lc5>!u}oGPbU&ZEIdBrU{BJfuKQG%&KrIJ-dRcWUbjKzI#Fh4Kb(m8gpE)^z1( zZNhOZ$*2UQMd>g29-nmj7s(Uws>s$N`FVuyS}dn(yaZ?Qb1!obevEmF!o}jlDuuSj z2PIFjycE$=N+7c}G@t~{{~?-If~N5>T`xiD_oI|)a-^jnul}j}!|*mVWg42(ST42i zIKeWM`x@kl6Xfm;RwI$~G_6ctXkjlaU6-+_2yn{*Mo{jg?+%*cmNTs5yyf}`<-1Y+ z#*6-7!Uen&ykNS_I|VDI%iF9Iyun;FUN8o9I$&iI81gVSz$LNa|AvAP78Ix#! z{)v8CEZ113BMSkPE^DaUZ!2bf@00S^65jMcH`Yc!@U+~+WSNN|I1BSpAip*hx&&=@ z4J9p+Ka7~g9uR%QO#*~iisCgkZD?AejpJl4m6t%-(V3<4!#GipvAKhGiZIh8kZ*sH6fnU*}WZ%W@m*ZluBe^#ZD{KszX>BWyfDm)TedjqorQ zQ9>nJ>tdQ#iMH`18!?8ey{BmIa&&B8SIYgRrzvGQQhSDmEk_AI%RV{K`g3_Xy6mM? zUIjYKsG5!E1l8y1auujnQ2GmSw9&8^cGSR z>mDz^FBt4oj}^$u3g#VaZnm!!Ns(|e?)a_}_LB4XnDZiMr7iumLcR$-KOAi(UjxQc zlPPd;>a#+QA`VQsY@0yxEU2Fa12}_A=$F?~=qkw5Q!mf#RUlDqFodj1gzU_u1U6ih z3Bx+b%k(CZ^H)fE5jo$?d0lAT0zzEM&FS)LSy}m#oCw7|NUkkqza;a$4A)C?7t1zI zu4?DRNUPgRtj6Hk`iK{97qGtHTr=JwGTmo2+GQ=)0dg`eS}l*T?BtZ`$TS>b zyS5rd__|1T!ple&>SSL=VeeumtV~`;)ZLuJw$LeS$SPzFGOY`H8rz{Lhh><}_BR`( zzE7m?SpyRLMe3J0%mKr0oeqY%sGEDkB9UxJj zKXA2uTS)X@-W;xj@ZJ$DFIXq{fOc7f{j=*(kc-x$^`@9+S8IiLZoSfoz6=S`P2@Z2|n&wuc{-2@hY6$5)A%IKO z$msiqedT&s&r;~Cs1|h%#Pfk*y<|Oxmk+s+Dg7n%cL&y^5IzzGa)a$33wyf_uzw=# zxorQ`$Rf85^z#Yp%zU~+GO zj4rL`{{W%2_WDNDy-OU*sC$1Sqnz2xqV*MQLZ1FDGP9KJUkQ5++rJj}(`?5FBd!|< z9HMtE%9a&GqkNJtl#K58^4R9`$LHHPa5_rnlSWFa6>)uDrEWJdRg8CHvLZ& z1#Oe>lWrPa8qL~2hIidrCBCc-g;+|-WFa)FV%!@ZR5!aRlf@Ai)tVYsGDH> z0oZB8HqKX#ycd)27q`o8EEXL1_cr9S+cCLmO1HMlZB5Oh>Cj7ZE9&u@>~He-g0T#& z(X@869B*nKO@FV2*&>?aSIc%f{TdojfJiEK2a*jG_7Q9kVmq!bvOSn8cc5bqVJD+w z#sqZkYY(vst?{6q zOxTIih@||T^7ED`IAd#PHBydx9Wy+o$U7vN9r4L+55{(d5_C{d zsi%&qokn$g!SVuK-eR&tYNK&i$GKOoklO0-AW2IEA5P?!mE!VT=^p%egyuh=U7^bC zHf{8peX?0H-s!w+f`>)CteBEe6a(BbLsr&@$)q-Pkh?VyN z1rvd%W!=;bVq7lESTg-^8ug+F^*tkJS$cvtW~Rmfa7GTd+*^-7V%)19o8JR=*5i(h zGwX3K^+07D(!t_<$JbGU|ZCCa)>_beboMF-hkmh zJAQun@pl#$O>?SV?3Ge;l1AaHUC9U>I=pli>oc1kT_-Q>CH1GvF-jQj8}1BIA|nPO z7FXC_`0+Le7t|ob3+uAFPz1#Ly9kIOH-Qn}*=3Y1&@h1>5Fv*PG(w<}0%38)@kR+W zTA(okJtWY>0*w`DoIsBVG+v+y0=Wd5C{T_-xdP#QJ99QkpveMF5h!1vM+KTHP=P>& z0u>2VED#^80N2w5Dix?qAh$r!(8}pyBF`ab3N%X~=pALh#|4@#&>Vs03N%lk`38zu z@V^v8xd`}#2)Iz7MFK4r=t+T|66k4xo)PF-ftCogRG?)7Jtxrf0#yi9DbR9(sszFe zo3pnjd%$R4veYQ6D!jLKhpQ*rbhA9i=2o zn?!(DMDWc5Z4qdzK-f5oR$@Z8L3~csT&~GngKLEEcH#S4Bi|juw^mTvNeQi$$UtsV zz6S6*-HKKeni8#qulzFHZ1{1DW74|}KR(XJ8QUXh;5-|ny#l={&_021f{pzS2y{>& zydlJ5eM_Lj0^xibhkRS0e+l%C5YJJ8jtO*Jpc51rtMr0mK_*5o$0*P^6syEyQffGy zh*4C!5USveTZ{tbHK9rf-_YSS>O>kJ2=t*qP>~m>D5j62>7qlCF~2l|ekwfA8DgRf zaY_`aaf*`;@4_Qy7eq>{?l@c$p)ZTL{}$*gfxZ^#8-czR=sQ8z*+vPsevg9UVJm>9 z#Ueu`Z502|AG~hd&GC@+9}(?GLF6Zat_bwAKvxC2CeU?(ei4%URUpjjSpL5W^t(WR z2=u2we+l$of&NFJn*!Yu=x;&uwm?lNGXXRus%1!^i#GlBdC zg2FcriL+=NvV}ml=(2e-caB;OEV?oY6k zO#;)06T$RQ4xb#I-6-fVZ_o!C1RX9C8X-!3q(FGxnzJ%WAZ$4@8e>SsIumJede|#u z!8|NvRhxulp+SkA#!+Z{aFQ)c<|@w+e`9aw5wbdzw%FK9XJdlMmP=5a?4>wSM9&cv z&pMOQIMSubkpwK|3qSkb8v;xIO z?LfR(B=7PjUm}v9CgPQfOqU7d7HGOaGX$C`&@7R{V*))c5H7}ZNzV~zu0ZodJnWUR z-vWWk1$sh+T*$KHYu%mNW8hj$uJ%f#>B-g<6sySea(i^VPZl7utYH)9Vy3ii7 zc}6&fAOMxH!xBLpqctbBOdyQbjPQIXmnTMRMwP-3qcx){;fK+h(F%buS~DVnFj_Nu zQ6P-gj8+RO7_Av$Bau_UXw7JyKp3qVRf~A*1==9cMu9d7gn^nvZWagwHIQj*!=i(p zb`G&kgs5SJ4Q)K8s|R#YW|^$py*2$cTGmmCvF`A~TG|PiveOG+hsj?$75sP(&v&ki zytUyCZm;@ggqy(GrwW)51@|~aYB{M)TAEgYH$W{#P=uyL! z3C#j|E{($i-i5{Dhm_+odZi(Al^C%C(OoZ^vDSEDo)RVL`u2Is^BM;Ko*R`@mN$`N zAU~Q74SC*YKrdvEI?}c0 z@mc5+uUf9{RKmeac{=vLV_!!@c!yG6S7NX!m-z;&!Z94r06K1<=o8?Q&mlnk#)<@n z(P^C&-tT(7qZ)ai65gl1-uyj-*E77zGJpNhUtDTyf1jYdHLSZ`wQWH(d*r;k@uIv`;yn2d2AT_vf+)LyRN&@b$w+Z z>(}1EX3E@+a`{G(_}1&nZK7e;zB9ZNzK3@{ytwEh@Z+ym4TIstGz;oK2*%s2|5vad zjbIXjM2kp*ooS)j-iVyi9V}&@i8P7!avP|L*nn zt#*C2;}63-?oW98YKPp2!e2%Z(|=pjXS#APUI@hK7M8-*jI$DspYI?7cSWxNbJvuM zUo3u1HIB4*1y^K032bgZQrbpgXx|wbnri1me8g=Jy za1~%Yl&R0zr%b`sQ8+-a1a~i6vMu;9eLxAfTm&o7uzt>rgDMA<_Osd6Omm>t8&j-Ke4(IMSBrgTT( zuE&-6fy^^kSSHhtjvhxDU!*I?m4#A2ns!2Y80gFijHMUpuM^65m=<3?2~Jv2=DW&l zY)&40SLtpE1Upa%@-Dh%ZfHRicM3udrXi=4ww4fh;t}WjWtlsDXfe_Iew&m z>6Eg_WP-Z1M;?o74UYKncH@I7H1B>2Q#|v8e z;h^(br4~f4pM~t#P|rFrzlI9gxJYa2K=LA8u2cFM-}*XH!hDo(S}(-AIV%JwM?O$u zP2jEYBZw!QMt-c|K#hLnVO@Jpm%2fEZGCx8A3 zzW7$@XEzgs;QhaO3vvh8Q!X@075WGjN>jY^=n0o}~g@@44qhOgLq4 zGxw-En}mZ4@lE~P_wZ6dxindgEB2fSQ)Sj>0dq6)VaG33&wbjO=G=nHUX_l1uWZ0< zBL4^FEq)9o=|>FR{^a^m85PQ<%!IfXVUEYqN%pPOrJqnHSb@h~L50;I3GAO=#{?+* ziZKhAb_FH=6z#sEDAudE+`^lBIFfV;A#PkzI)?Jl&$|#ly8hJlXVf>Wc7H}Y*+pOc zti(jH-Vy$e$X##_e$0T40aHpj&65QF;}BeTeZ3ln z?`uj}1fO)A1m}jd58**yq~4Z3zNU4$L!@%5W zpP#>e;I@Jb0XJ4$R?GhRYJ{FAsXwxc2vld| zY|YMKHI+(C=rzs;s%{)%g2QB*un`I{YJ=3#ILve>M3r-#Kb;Fy3vjdvj%6lmCsYk5 zB-ey?o^1sM{69dER9YIe6lJ$m#bqEI2dsdeEE^x^J^Opp*s4qE7z)BvH)WgEC`!X4 zFS;j8oxmqerB>>E80D?hG8n(LQpdOC6JWlhg4{T}#L(L13G(KrBUQiuT`-Y)ZEN)> zKB4>n6W+O4_4{y~7dw)!ekx%J{$hsO221ca+2}^+Gt^XUuvROb0P5ILRiStR zw%m>?cGo%El7WAnnaSl+m5l5IP5&?(VFb z{jfMUimalmx-_&eC~?KVqnwp8&qG~TpKj`4={~)(o7#(Y?br2E7vhkU5l=73QY$R9 zr6VZ6(-D+!@PCN|)I=KG8E#_-s2-ZaNd^p5J&@z}fhx{y5om?!qX(&&gs-M?Lsdn( zUoRi3u5Jn`#675fZo-=WuhFOy+4}S`YLrQ18sX86@R&yUp+@-OyD<%&pazn^OT|YGml{s(Txu+R??TBBW?SM! z*b3M-Wuoda<;7I4ZAG>mbqY4}U3sV}(4&gCigMJkIPYW4Rb!+nl#qv0sh4t9n<+nr z-kYelqLN(I9|P|lkA$gSCb$=4SrjzFh4o>hiyHYA`!GqlNT^+&8iEf2(qt5FDf2YB zWtlewcXdqN9Ya6I;kEK>d1{npI(t%P4yv(jlIm}o(ZDleW}}$1>H{yBq=w@R52r&t z@>D0)A~tp+jD+V3W1cYP3uA#W$_;~Fn50gi1$%9nx=m5lk&C@4`6TdUBm7h&{B$Gy zOe6d(W2*cKqv`1>=qOTf0-w0PU!j+Bi@RJ~{Z8o2Qc$oFXJS}*2>CNsUxizB?)%Ew#9gH`4F^|uTH+nHoB=XUb51p!7@jYYAR5b%{cA*ks+heL~#$E~cAcQx0 zpzG`7ra1pTRgFs8(un%jM$}*RQK!mI7^bp=WwV}GpyE!;HriQ;p{a(xC{(whOM0dV zwKk2mv$0yQD^jmEleW{58R|OeHQhB+g*MDrbqu)QSM0?h6nHqJ}qB@6MiO2iXtu*q8M zAT%E4HR)b+uh)FjYwq)!`@QA?uX)gG9ulU$>nU}tiPDy!VSm7BCi7CBjgN$Z6+5F( zgn<=1BYXg<1QX|}d@07U&kRR$E&)1eHHO1pup!?1#(JD{^dDhh+0E!D5$dDoKxaXPnuc4l zJ1bCKvGQJ`wl&x_4*K&DlR(3shntb{>zsZvd8{}+UGkM5=G;nrl<60&t?-hu=~u6L z!)yNLHGlV-f5gy5d%T0buJAF3#Wu6^UvILTppxm&ux{(gf_{+E$>8w&mm~O`C zE34F2X3W606DA5c5J2i=7@bzBybCsNl{(*&ib*eKUxa}pRll`LUC3t}%3o4P89tq< zjxc~YPZf>Y&s zCQjSetKAzA-Lpac+H7EamRN;EZf;gP`r*uI`Zjft6dDh{c>bN`ZEBIUtOjiq$GvMn z?FOBxQ70RZ>|_|?&TOqgDbaGQ{U&V3O!QWaUbVF zYM5aiT5rv+w+^efzEE$)#|2-s;q}(h^;Ud1@CCpJ1E009-da>|Ev~m>d)^lo8pC|n z(t2xIz13ZBonCL9QE#1DZ=F?dEw8seQ*V8u-uhg<6`SbSa8oO!JuZGalTl@zW6>em z-cVI53y=Sb=(^pHze2g*P=_0GjG&#n)Ha4SnuhIHlMQQFy*0ev+J-LgN7Jx9hjmWc z8!B$^?ZbbbU1|W=kzFWbeBRoHDv(NXyV1O`eAun>Zf)gmbStTJWH&mQRQhW-MpYb# z*`w+PW9{!SW~7}~pCC2{-bBYTR>$0fv(Q!GrMkK|j&Tmh#E-Y4H2ipo;`t-;x7SFx zdas%j%^|zN^`D{Q-c;KfgnbFUsXD>gnm5%*e~#51u_$dfW^m`;L_e5H*WXk#j0pEK zC)kqOr*a9=KTc5@^a2!9h z9mc#0Wq#Pp*yBbBX5Qz5X&~ssrP}8*uWBbAkxjFOnw#>x<8O4Qht(&rjpRC_;wV1~ z8#{65%wa1x1)KN0tu8Q0x5bp>@bU!c%CbNet#hU=K(BpA#TBb2)bkkT4HA{VqsEZ= zxVrKGUVi9Uemu`NV1~Vmc_2G9|6Q&z??y)qa(IS>!TM#UhO^pbr+7Hx#IG-Syz9b6 z+=}L&Q%^yF1I}X!8cCPWtC2xbpv`ktWQu>u zcK`P$cs5Oo<%ieeY04mT2<3jMrdjNW5I{S_{n}Ke{Q@~v@)l<*xos|#PM3vheP z$a9jBXR5fQ-h*#oCoh4&WOj)W%vjiCi^Bpv*>x-gJi z=kwmI;~O1(G2ulZ%#prQ%~lp4uYnS%{A+Z+>Fkw?4Vmj8X~>pW;VfI0M@GFf?@jxh zaoXT3aP2%}GvnTw>uWWOX8ju(Km0X%^^tVuYZUP+cJRj+KkR$dvy0cNzCv%3=0yFT zQ-}XTX5cON3A1DbJ3+0qR%!d<+J;5O}BH5=@ef2)SYG1I)b^p$yc1j9e0o?>(9 zTQw%3M?)tBm*CC&c9D02UHKM8+mi);+;lHWsf%B0GJlV$XfHkGd(4omPLSZe!XV1* z;uofu{D3()E|eLi(p!`YY9eOpy|KPH`yUk-tkUsBH0DrQH0>wUsy-r+=O=Y=XkQTH z+Rc}W?!hmeZvBMxM^gF~W824d1#`3Rbn*%cp*vlQQJV%|S7Sr(|A!w_ zmeTdg>uRusou%qu)L%s(UsYLyBeYGS+M)JWwMN4E%yGX#!o$36>o;|lh4a{&%1fXO zCS+wxs0R97&6T{a>93E9Z z?3d7X;EBV?Q6XtjMw+;*+@8;MOPbj9Y>L-NLeLG|#+zniP1;`R0gCX`)=9(ZV4|i_ z_S-R7S@~(K(MU3DZ=r`eV%DY_PYOD?Gml19#^Y5`tI|wcge!k_&9tdv0P1_$ua`&Cc69!lyM(! zhwZDw0opFFWBGg>VefI<0{sr{Fan<10Q^@H8iaR#1GTdzX*5-aXgc^C z5UP#BA)e|`ZNDKfs4iI+&uVuP{>Bzl!OM7Qj5+8=$XI`-0H3*K4rTBvw zQvBz4=q77XFVZK>nA0#JbdZ-`Y&FfanGUP#|t&C z$PTKE*D?ZmInF~0i*6#%6p}5x_tAugeH_9jyVk8S!GKLz^5u1*!7Jmst`w0es@bQ<4s?%#si9 zpsLK(&;|A(7TT!W6EH)oOh!fG^H^FhjK$ZJwNG)0_+&e+OQ?f+#UGapOQbJ_rf9ud z8rcWr0f?P%#?ZtR?FoD#{3b;kiZfjxh3ER(YXO#INXlGQ-5pIHuRD{o1@ss#Xs?+q z1z;tRroE0SjR!ci5SRr&#Y;1pcDL8&#}#=q^s_fZfOmr6x>%|fX5lDnrsE3fVVnU!?V(r~yO_6*Z34C3##X=Q!POFWf+>!2lDAHM^WGSG?-kt+km z2eKJjn8swe+4~A?jF%zKQI3}}8@|vqj%e_MW2a?!pxfC|3%K)X@9v1Mjv}d!Xqu^X ztD`nvnoZ+6Y5k(-c)9XG%G_AE9kCQ}7@(7e)gAbP8neBDVLcmubwmK;B#9BS5$oKm z^55MYWOhc2!1hOHZ}cqp6g9|FTO_d%(*XqOmHuScG0>^^JqvHa6OL-yJ)Gn z0lS9L0{vhY?P7e(WF+d^(8MH)8%xT8Az|Pnfb$OKMjXvZRL#sAm$X}!mj+I_8Bdfv(MWM(;QCaibX z40N{DGV*Ed%i4N<)Eez)i=WM!uyUi8KsPsN*G`P1+BV zNjjiAersk7rRE>5Yb+6G@K#faXjkecpGTpB)*{OB*C;xrm)AwJJ`Kr{Ujymnr z9;9_=w0wxBn^z`d6B+osiIM-G@ zBd@eHKQ}k8s6B!nJ)m_$m=*^y5P9fZ&R3T*DjO7b|_ zpW$ovjOaR&UhCqB^kb(nhqV~Qd+x9n1!K=)gUXe|+Mq zdqz8b&-|LXSnBzQ)>>NJlj&UNOwwG=?meB|HCKhl=W%bQ(r<8QU<2 zL8rTYNDGJpvS_Cii9b!Y>h za76Ky0bb(*$#7~OU~g@iE?MHoP~8uh-1P~tPr0`z^M^L1qH_G)$PQlM(7p zJqj31{|T_q%yc!Pk#~3g0v>HhrtqI+N@;zd-D!DWvb;2eGJn;gR|eUGTb6^W+MqrM zET)7Y`~A3cT@qwZ!6EatL3Y*#i&Abw-vrqcaUwY=*gi;->7iizM103O7;LxW+mTTX zZU)=^Eu$sN-hp)F3k?s!h1dfE$N6}vwFFL}P9gT(bPcIGL{H|*FLHau5}4E=WV;60 z2~4GTL+oSXtJuw{pq+BnF^Bm6<5nE_5@m+kyNuZk8qP$`t+}}^dup1@@loH7Dy+;w zbG|Fu>m1(h4ebl6v!iMd@Hrizx={NNd=hNa(%u^1`?|HXcf$;0dP{rysK7tK*rUFX z|3x~Qv%5p2WbpPk@+%il@`ea989X|>7f))KL{PK4L$#n=E$xvHp~Bsv9fTU^qwTBM zLD3v7rqr0J&-s!-C zP)pZ2leID?e0Mh)G!S&vnN#w7yA`S&UPMZ!bAuBy zwrRtC{XkF$IvZ|pm5Ba$z3?i#Odn`fKsF80N(qU=`ouBM=0X$b3=swdNsG^II_Pms)h7W}TBd zKuJiq&Ph(x(%GGplJLoPQ|F{Mk=X+)`e~C~1!Z~mLSuebYo00v*3svklVbeG4An5t zaTU_A^2AoO#g&N1O}iweN~iS+U6M|l(Xvx|B)y8y1m}7rO_vtX{XLWJk!1a;o=JV} zQj~rsC+UxAQ%rw9P-_m8{H6@AHHS-n$0pXABP73PC#x9u-L>XO$*;OeR;@Wo^4mT) zsVHwIy29ep+*)&M$?xp_$_!V5k~gcU)*L7K{m{SG954BOIieQhO|97`nIrDw0JUb^ zL$d4bK1r%vs2>^QsA+1tr-NQR!4Z@smFx4KakQ4^?>UP<=koTMW$y9$MaD$3$XzBi zKkv+3-p+8u1jU7klhk~zv-ffbI~BT0O7h^a1`(4p-R{!yQ}PN7m-WuftmTQl^NXgt z^9#x(OO8QY>&=~|)S@S7cIrJnzaV!!CO%WfW9CSaOC0i8!9&~LkGbl~9r%Z~1j;Wfi(RxQdF3-BR#aChCC0cuXVi)LyAuIAxy5M z*dh+zo;?A_i}i^VlZ-Hl>{yszmLs)3L_3x`D0lAz= zQlGqu(VvMuma7pZ2nD5Rh&IOZAIWfi77wiYz;LvthUDIbt!7Y)BHUJ9@x77Rwl`L~O zGW_9`JfJA2U^*s<#ie;ta3*3nye^nKO2NCBJTEnP0xiX~qch7KZDZOSln1*CC+51O zuveM#;JjHV1Zy`6e$J6Fe+`_H1{W7i&NmXYRD+B<1YAq8^O?gWwvTs}B2%sR8r8(X zF1e-oSO-b5^AH^lQ}c3#RAN-rzQiFecg_?DLW;Ozkjrzsq^S0&bbb2X*AL{m0Q`<~ zb)p^5Ia=V5`~K$~vGY?w%s!M?J8mh!#`(#1adGENkwT^!GS=WwmM2;J8QC%bvJ#AV zYBs8>)ciJkAeu2>FOxzPc(u>YD=o_}b3>rxxwZs6fiU)LbPXUC^(YhWvpgxgWIiYC zDsxNCDh2scfZ7M|(tH#hGA*@;boTCxG<>0(kK>Ghq{DFH@-CHPZX!~$;ZPui zAJLa3W4NGINg-_vMwtjIpA>Y}nfVCnkm1j@F;@!mXQFMhON)8QAelQe8xQ2=jL(^p zmorrgHDus;V0w`|ztCVbDg`0h4#!HQAb*k+<=_N{yK~3q&B}L6u?zH!3P)$Z`E3ne z?ZY{dGAVc@;%LLCPeir@(!im8_)OH$DN@96Lz2TED|GXcRf^((Ny8t5giw7-CCd&c z#Mbw|Vd^-JtBUUP- zA6{_8M?DQ9X?KE6FPd093*{FwhuW-gM9zQQ;Gb!_OY`!i0E5}K9GtTg_7ox;sJO%} zh4x{oF4x$%OlsjU7&aJk=glgSf`3Nfq>)8#cymP!p2Yl)5^H$$IyPq(8d(2Pp92zmQE@WrtNixDSjoKbJlIb2C(Hzv%chWJ_VQnur&2e`$D zdCBp9$dTRcVyEqyee`Eb^?$q9EVk(zRy&|4=jb5Q#zUV^d;D0JZ^Eh5gk|*m%Z^_| znq&|7VPKP>b~}%~{K6m3-HQI#8plB?WJLQea|?HWu;t3MK`%Ub6^De6t#iyUg?wM9 z-TGv0{~0fA=zD2gRNq@Pc)cSl5IbORtbJ#aCp3eNJ zXKU-sA9H$mJfgd;NIP1xHvaYTe-AkE;CH)MKECP*J+;X(Aw-^?nRXy_K=)%=zuNZY ze2`3kY;sWhC!=O|z7R8N{N;rkKM(P=uJCx0vM`pRqnTJxk#^z!vZ=CX*YNITvf)tQEHC=O3hs4$Ymt7SL~79Y2O_^Kai}{WIzp#rwjF^r5$B z(Y03{3BA)+^%Nc!9QXm Uf;7u=6&9p-?b>y8T8A$G50*(U*Z=?k diff --git a/boot/ocamllex b/boot/ocamllex index e353edbc56af2f570c31b60b5c0c7f830de1c212..9a1af6c673c5d8638fed16922049f6a1fdc93f2b 100755 GIT binary patch delta 132 zcmV-~0DJ%0i51z26@Y{RgaU*Egaot&(mfD^^9y`tiop1veez6Q^gbZB;ynf40T6{u z93rLM@!5f4-ZZ=J8ikk8KLzs;pG8Kh+?{0f?QoGZfVMYvx6?ociUAOtu+}C%+3b?j mfH7z+wl?p#Z9)YT0uYN-+VV`xF+tl;%7t8pkYAUOLhYJ5LL 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/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/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/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/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} From 3325876e60fb4e136f242ec5703ae69372f30a01 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 19 Aug 2020 19:55:07 +0100 Subject: [PATCH 100/160] Don't display configure in GitHub diffs --- .gitattributes | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitattributes b/.gitattributes index 4e4be5874..296d539a8 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/ From 92ae58e9c1515ddb6aa5946be8ec30040b7360ec Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 19 Aug 2020 20:56:33 +0100 Subject: [PATCH 101/160] Fix typo in configure.ac --- configure | 2 +- configure.ac | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/configure b/configure index 0638afb45..2209a2ea1 100755 --- a/configure +++ b/configure @@ -2811,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 diff --git a/configure.ac b/configure.ac index 1bab4b31e..cddb970f7 100644 --- a/configure.ac +++ b/configure.ac @@ -68,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 From de791aa113ce97da2fb3b2a67408a3b12bf6b90c Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Wed, 22 Jul 2020 15:04:19 +0200 Subject: [PATCH 102/160] Changes entry for #9753 --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 659e1e42c..dad54827e 100644 --- a/Changes +++ b/Changes @@ -384,6 +384,10 @@ Working version (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) + + OCaml 4.11 ---------- From 53fe14a5412656200a3149a22d06c77377b98689 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Thu, 20 Aug 2020 14:36:27 +0200 Subject: [PATCH 103/160] channel_of.ml test: create temp file with O_SHARE_DELETE Otherwise, under Win32, we can get an error on Sys.remove because handles remain opened on the file. --- testsuite/tests/lib-unix/common/channel_of.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) 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 From 781b37b688acb3779d7e6d66ace8f044b905c2cf Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 20 Aug 2020 15:06:46 +0100 Subject: [PATCH 104/160] Actually remove directories (#9849) `rm_rf` removed the files (recursively) but not the directories. --- Changes | 6 +++--- ocamltest/ocamltest_stdlib.ml | 9 +++++---- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/Changes b/Changes index dad54827e..8d991cf0d 100644 --- a/Changes +++ b/Changes @@ -315,9 +315,9 @@ Working version attributes are present. (Matthew Ryan, review by Nicolás Ojeda Bär) -- #9797: 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). +- #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) diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index a18285984..e6ce21d7f 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -94,10 +94,11 @@ module Sys = struct let rm_rf path = let rec erase path = - if Sys.is_directory path - then Array.iter (fun entry -> erase (Filename.concat path entry)) - (Sys.readdir path) - else erase_file 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 -> From 491cc88b33d8df1084764b21b40bb1f00b82e200 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Fri, 21 Aug 2020 10:11:17 +0100 Subject: [PATCH 105/160] Mark Obj.tag [@@noalloc] --- stdlib/obj.ml | 2 +- stdlib/obj.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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" (** From 86fe4bdeadb45ef36495c9a833809a6b285165c2 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Fri, 21 Aug 2020 12:37:26 +0100 Subject: [PATCH 106/160] Add 'toplevel' directory to 'make runtop'. --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index aa7634bd9..57e213a57 100644 --- a/Makefile +++ b/Makefile @@ -77,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= From a69be67e333f93e263179b2b471b6c3c330e36ac Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Fri, 21 Aug 2020 20:42:15 +0100 Subject: [PATCH 107/160] Treat set-but-empty OCAMLPARAM the same as unset In case the OCAMLPARAM environment variable is set to the empty string, the current behavior is to attempt to parse it, which fails to find the `_` character separating the "before" and "after" settings. This patch changes this to treat OCAMLPARAM set to the empty string the same as being unset, which is to do nothing. --- driver/compenv.ml | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index f27b377d6..a8e93c15d 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 String.length s <> 0 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 *) From 6e84a1118156bc70f5260cc9ed0558ad22d1f9a1 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Tue, 25 Aug 2020 15:22:46 +0100 Subject: [PATCH 108/160] Fix double free of toplevel bytecode (#9855) --- Changes | 3 +++ .../tool-toplevel/pr6468.compilers.reference | 4 +++- toplevel/toploop.ml | 16 ++++++++-------- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/Changes b/Changes index 8d991cf0d..612597fca 100644 --- a/Changes +++ b/Changes @@ -387,6 +387,9 @@ Working version - #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) + OCaml 4.11 ---------- 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/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; From b735f187acaf284148f0e41ca86be8eb08347230 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Tue, 25 Aug 2020 16:27:11 +0100 Subject: [PATCH 109/160] Avoid Cconst_natint where Cconst_int will do (#9838) Cconst_int generates better code, as it hits the instruction selector's cases for small immediates. --- .depend | 2 ++ Changes | 4 ++++ asmcomp/cmm_helpers.ml | 16 +++++++++------- asmcomp/spacetime_profiling.ml | 2 +- 4 files changed, 16 insertions(+), 8 deletions(-) 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/Changes b/Changes index 612597fca..eacae5087 100644 --- a/Changes +++ b/Changes @@ -128,6 +128,10 @@ 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 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/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 () = From ccf4df07584087a7fa3a14f365cf348c56f64e5c Mon Sep 17 00:00:00 2001 From: Leo White Date: Tue, 25 Aug 2020 18:01:03 +0100 Subject: [PATCH 110/160] Remove spurious Ptop_defs from #use (#9376) * Remove spurious Ptop_defs from #use * Add Changes entry --- Changes | 3 + boot/menhir/parser.ml | 13315 ++++++++++++++++++++-------------------- parsing/parser.mly | 7 +- 3 files changed, 6667 insertions(+), 6658 deletions(-) diff --git a/Changes b/Changes index eacae5087..55d952e6c 100644 --- a/Changes +++ b/Changes @@ -283,6 +283,9 @@ Working version - #9216: add Lambda.duplicate which refreshes bound identifiers (Gabriel Scherer, review by Pierre Chambart and Vincent Laviron) +- #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) 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/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 From 41f0522df34fe868037631bb804f8e0f177829b4 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Tue, 25 Aug 2020 21:22:34 +0100 Subject: [PATCH 111/160] Use different symbol names for caml_do_local_roots on bytecode and native code (#9503) --- Changes | 3 +++ runtime/caml/roots.h | 13 ++++++++----- runtime/roots_byt.c | 10 +++++----- runtime/roots_nat.c | 12 ++++++------ 4 files changed, 22 insertions(+), 16 deletions(-) diff --git a/Changes b/Changes index 55d952e6c..334c6588f 100644 --- a/Changes +++ b/Changes @@ -54,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) 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/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; From 4c1654f135093866f64b1096379ae043878245b8 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Wed, 26 Aug 2020 09:23:44 +0200 Subject: [PATCH 112/160] z Systems: subtract immediate has its own range of valid immediate values (#9860) Because it is turned into add immediate opposite in emit.mlp. --- Changes | 3 +++ asmcomp/s390x/selection.ml | 6 ++++++ 2 files changed, 9 insertions(+) diff --git a/Changes b/Changes index 334c6588f..833ad2edb 100644 --- a/Changes +++ b/Changes @@ -400,6 +400,9 @@ Working version - #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) + OCaml 4.11 ---------- 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, _) -> From 34f20c7746e0e9dce37efe3b7f5ae6a3bc301796 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 29 Aug 2020 16:48:36 +0200 Subject: [PATCH 113/160] Update copyright years Using an interval 1996-2020. Fixes: #9834 --- README.adoc | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) 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 From d356562d0fa5850d091882f19936a810bb0ad044 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 1 Sep 2020 13:57:48 +0200 Subject: [PATCH 114/160] Test in_channel_length and seek_in on channels opened in text mode Repro cases for #9868. --- .../tests/lib-channels/in_channel_length.ml | 20 +++++++++++++++++++ testsuite/tests/lib-channels/seek_in.ml | 19 ++++++++++++++++++ 2 files changed, 39 insertions(+) create mode 100644 testsuite/tests/lib-channels/in_channel_length.ml create mode 100644 testsuite/tests/lib-channels/seek_in.ml 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") From 4066fbd69cc09b8e3f5ca991c370f8420794b9ac Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 1 Sep 2020 17:26:00 +0200 Subject: [PATCH 115/160] Fix overflow detection in {in,out}_channel_length The LargeFile version of these functions was incorrectly reporting an error if the size is not representable as an OCaml unboxed int. --- runtime/io.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/runtime/io.c b/runtime/io.c index f36f3251c..a0e998aaf 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -592,13 +592,14 @@ static file_offset ml_channel_size(value vchannel) Lock(channel); size = caml_channel_size(Channel(vchannel)); Unlock(channel); - if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); } CAMLreturnT(file_offset, size); } CAMLprim value caml_ml_channel_size(value vchannel) { - return Val_long(ml_channel_size(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) From 09f2b9dd574d29468807b121e95bc0ac2ac34afc Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 1 Sep 2020 17:28:31 +0200 Subject: [PATCH 116/160] Revised {in,out}_channel_length and seek_in for channels in text mode Under Windows, for channels opened in text mode, EOL conversion causes a mismatch between the `offset` position cached in the `struct channel` record and actual position in the file. This commit turns off the use of the cached "offset" in the implementations of `{in,out}_channel_length` and `seek_in`, calling `lseek` directly instead. To support this, a new channel flag `CHANNEL_TEXT_MODE` was added. It is set for channels operating in text mode under Windows, when EOL conversion is active. Fixes: #9868 --- runtime/caml/io.h | 1 + runtime/io.c | 50 ++++++++++++++++++++++++++++++----------------- 2 files changed, 33 insertions(+), 18 deletions(-) diff --git a/runtime/caml/io.h b/runtime/caml/io.h index bc8316084..475323993 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: diff --git a/runtime/io.c b/runtime/io.c index a0e998aaf..72bd9b5fd 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -80,6 +80,17 @@ static void check_pending(struct channel *channel) } } +Caml_inline int descriptor_is_in_binary_mode(int fd) +{ +#if defined(_WIN32) || defined(__CYGWIN__) + int oldmode = setmode(fd, O_TEXT); + if (oldmode == O_BINARY) setmode(fd, O_BINARY); + return oldmode == O_BINARY; +#else + return 1; +#endif +} + CAMLexport struct channel * caml_open_descriptor_in(int fd) { struct channel * channel; @@ -95,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; @@ -139,34 +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); + 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; + here = channel->flags & CHANNEL_TEXT_MODE ? -1 : channel->offset; caml_enter_blocking_section_no_pending(); - end = lseek(fd, 0, SEEK_END); - if (end == -1 || lseek(fd, offset, SEEK_SET) != offset) { - caml_leave_blocking_section(); - caml_sys_error(NO_ARG); + 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 */ @@ -349,8 +358,9 @@ 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_no_pending(); @@ -622,6 +632,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; } From 169892a0d05f403799e3df90394df4ae74ec413e Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Tue, 1 Sep 2020 21:59:05 +0100 Subject: [PATCH 117/160] Use polymorphic compare to empty string instead of checking length for 0 --- driver/compenv.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver/compenv.ml b/driver/compenv.ml index a8e93c15d..6f587f268 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -458,7 +458,7 @@ let read_one_param ppf position name v = let read_OCAMLPARAM ppf position = try let s = Sys.getenv "OCAMLPARAM" in - if String.length s <> 0 then + if s <> "" then let (before, after) = try parse_args s From 63c7071a34fda8844bfce061c7c02fb52de9da75 Mon Sep 17 00:00:00 2001 From: Yishuai Li Date: Wed, 2 Sep 2020 04:52:04 -0400 Subject: [PATCH 118/160] Add Unix.SO_REUSEPORT (#9869) Support the SO_REUSEPORT socket option. Closes: #3512 --- Changes | 3 +++ otherlibs/unix/sockopt.c | 4 ++++ otherlibs/unix/unix.ml | 1 + otherlibs/unix/unix.mli | 1 + otherlibs/unix/unixLabels.mli | 1 + otherlibs/win32unix/sockopt.c | 4 ++++ otherlibs/win32unix/unix.ml | 1 + 7 files changed, 15 insertions(+) diff --git a/Changes b/Changes index 833ad2edb..c2779e19b 100644 --- a/Changes +++ b/Changes @@ -219,6 +219,9 @@ Working version - #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 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 2cdb2643e..2872dcb53 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -1429,6 +1429,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 6b4c93744..f3fe0722c 100644 --- a/otherlibs/unix/unixLabels.mli +++ b/otherlibs/unix/unixLabels.mli @@ -1175,6 +1175,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/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 From 5cc12b8100aae9c808c66f13713f3673f7b0ed3e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 2 Sep 2020 11:41:20 +0200 Subject: [PATCH 119/160] testsuite/tests/formatting: remove native-compiler location tests (#9871) The tests for -dlocations are painful to update for native compiler backends. They were previously restricted to 64bit architectures only ( e57785524b75dde6d0cf22bac9689cb76dbcd885 ), and disabled on AFL ( 829b00b6c7530825bc927168c8f2f3f092f78143 ), but the fact that they have to be updated for both clambda and flambda backends is annoying in practice. This commit disables location-testing completely for the native backend, and only checks locations in the bytecode compiler intermediate representations, from -dparsetree to -dlambda. Note: now the we have bytecode-only versions of the test, it should be more portable. The test has been re-enabled for 32bit and AFL configurations. It will still need tweaking in the future if people perform configuration-dependent changes on the Lambda representation (but hopefully those changes could be disabled by command-line options to be added to the test configuration). --- ...test_locations.dlocations.ocamlc.reference | 116 +++++++++--------- ...ions.dlocations.ocamlopt.clambda.reference | 31 ----- ...ions.dlocations.ocamlopt.flambda.reference | 38 ------ ...s.dno-locations.ocamlopt.clambda.reference | 28 ----- ...s.dno-locations.ocamlopt.flambda.reference | 30 ----- testsuite/tests/formatting/test_locations.ml | 38 +----- 6 files changed, 64 insertions(+), 217 deletions(-) delete mode 100644 testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference delete mode 100644 testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference delete mode 100644 testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.clambda.reference delete mode 100644 testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.flambda.reference diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference index fe3fe29a5..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[43,1389+0]..[45,1427+34]) + structure_item (test_locations.ml[17,534+0]..[19,572+34]) Pstr_value Rec [ - pattern (test_locations.ml[43,1389+8]..[43,1389+11]) - Ppat_var "fib" (test_locations.ml[43,1389+8]..[43,1389+11]) - expression (test_locations.ml[43,1389+14]..[45,1427+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[44,1412+4]..[44,1412+9]) + pattern (test_locations.ml[18,557+4]..[18,557+9]) Ppat_or - pattern (test_locations.ml[44,1412+4]..[44,1412+5]) + pattern (test_locations.ml[18,557+4]..[18,557+5]) Ppat_constant PConst_int (0,None) - pattern (test_locations.ml[44,1412+8]..[44,1412+9]) + pattern (test_locations.ml[18,557+8]..[18,557+9]) Ppat_constant PConst_int (1,None) - expression (test_locations.ml[44,1412+13]..[44,1412+14]) + expression (test_locations.ml[18,557+13]..[18,557+14]) Pexp_constant PConst_int (1,None) - pattern (test_locations.ml[45,1427+4]..[45,1427+5]) - Ppat_var "n" (test_locations.ml[45,1427+4]..[45,1427+5]) - expression (test_locations.ml[45,1427+9]..[45,1427+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[45,1427+21]..[45,1427+22]) - Pexp_ident "+" (test_locations.ml[45,1427+21]..[45,1427+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[45,1427+9]..[45,1427+20]) + expression (test_locations.ml[19,572+9]..[19,572+20]) Pexp_apply - expression (test_locations.ml[45,1427+9]..[45,1427+12]) - Pexp_ident "fib" (test_locations.ml[45,1427+9]..[45,1427+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[45,1427+13]..[45,1427+20]) + expression (test_locations.ml[19,572+13]..[19,572+20]) Pexp_apply - expression (test_locations.ml[45,1427+16]..[45,1427+17]) - Pexp_ident "-" (test_locations.ml[45,1427+16]..[45,1427+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[45,1427+14]..[45,1427+15]) - Pexp_ident "n" (test_locations.ml[45,1427+14]..[45,1427+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[45,1427+18]..[45,1427+19]) + expression (test_locations.ml[19,572+18]..[19,572+19]) Pexp_constant PConst_int (1,None) ] ] Nolabel - expression (test_locations.ml[45,1427+23]..[45,1427+34]) + expression (test_locations.ml[19,572+23]..[19,572+34]) Pexp_apply - expression (test_locations.ml[45,1427+23]..[45,1427+26]) - Pexp_ident "fib" (test_locations.ml[45,1427+23]..[45,1427+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[45,1427+27]..[45,1427+34]) + expression (test_locations.ml[19,572+27]..[19,572+34]) Pexp_apply - expression (test_locations.ml[45,1427+30]..[45,1427+31]) - Pexp_ident "-" (test_locations.ml[45,1427+30]..[45,1427+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[45,1427+28]..[45,1427+29]) - Pexp_ident "n" (test_locations.ml[45,1427+28]..[45,1427+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[45,1427+32]..[45,1427+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[43,1389+0]..test_locations.ml[45,1427+34]) + structure_item (test_locations.ml[17,534+0]..test_locations.ml[19,572+34]) Tstr_value Rec [ - pattern (test_locations.ml[43,1389+8]..test_locations.ml[43,1389+11]) + pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11]) Tpat_var "fib" - expression (test_locations.ml[43,1389+14]..test_locations.ml[45,1427+34]) + expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34]) Texp_function Nolabel [ - pattern (test_locations.ml[44,1412+4]..test_locations.ml[44,1412+9]) + pattern (test_locations.ml[18,557+4]..test_locations.ml[18,557+9]) Tpat_or - pattern (test_locations.ml[44,1412+4]..test_locations.ml[44,1412+5]) + pattern (test_locations.ml[18,557+4]..test_locations.ml[18,557+5]) Tpat_constant Const_int 0 - pattern (test_locations.ml[44,1412+8]..test_locations.ml[44,1412+9]) + pattern (test_locations.ml[18,557+8]..test_locations.ml[18,557+9]) Tpat_constant Const_int 1 - expression (test_locations.ml[44,1412+13]..test_locations.ml[44,1412+14]) + expression (test_locations.ml[18,557+13]..test_locations.ml[18,557+14]) Texp_constant Const_int 1 - pattern (test_locations.ml[45,1427+4]..test_locations.ml[45,1427+5]) + pattern (test_locations.ml[19,572+4]..test_locations.ml[19,572+5]) Tpat_var "n" - expression (test_locations.ml[45,1427+9]..test_locations.ml[45,1427+34]) + expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+34]) Texp_apply - expression (test_locations.ml[45,1427+21]..test_locations.ml[45,1427+22]) + expression (test_locations.ml[19,572+21]..test_locations.ml[19,572+22]) Texp_ident "Stdlib!.+" [ Nolabel - expression (test_locations.ml[45,1427+9]..test_locations.ml[45,1427+20]) + expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+20]) Texp_apply - expression (test_locations.ml[45,1427+9]..test_locations.ml[45,1427+12]) + expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+12]) Texp_ident "fib" [ Nolabel - expression (test_locations.ml[45,1427+13]..test_locations.ml[45,1427+20]) + expression (test_locations.ml[19,572+13]..test_locations.ml[19,572+20]) Texp_apply - expression (test_locations.ml[45,1427+16]..test_locations.ml[45,1427+17]) + expression (test_locations.ml[19,572+16]..test_locations.ml[19,572+17]) Texp_ident "Stdlib!.-" [ Nolabel - expression (test_locations.ml[45,1427+14]..test_locations.ml[45,1427+15]) + expression (test_locations.ml[19,572+14]..test_locations.ml[19,572+15]) Texp_ident "n" Nolabel - expression (test_locations.ml[45,1427+18]..test_locations.ml[45,1427+19]) + expression (test_locations.ml[19,572+18]..test_locations.ml[19,572+19]) Texp_constant Const_int 1 ] ] Nolabel - expression (test_locations.ml[45,1427+23]..test_locations.ml[45,1427+34]) + expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+34]) Texp_apply - expression (test_locations.ml[45,1427+23]..test_locations.ml[45,1427+26]) + expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+26]) Texp_ident "fib" [ Nolabel - expression (test_locations.ml[45,1427+27]..test_locations.ml[45,1427+34]) + expression (test_locations.ml[19,572+27]..test_locations.ml[19,572+34]) Texp_apply - expression (test_locations.ml[45,1427+30]..test_locations.ml[45,1427+31]) + expression (test_locations.ml[19,572+30]..test_locations.ml[19,572+31]) Texp_ident "Stdlib!.-" [ Nolabel - expression (test_locations.ml[45,1427+28]..test_locations.ml[45,1427+29]) + expression (test_locations.ml[19,572+28]..test_locations.ml[19,572+29]) Texp_ident "n" Nolabel - expression (test_locations.ml[45,1427+32]..test_locations.ml[45,1427+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(43):1403-1461 + (funct-body Test_locations.fib test_locations.ml(17):548-606 (if (isout 1 n) - (before Test_locations.fib test_locations.ml(45):1436-1461 + (before Test_locations.fib test_locations.ml(19):581-606 (+ - (after Test_locations.fib test_locations.ml(45):1436-1447 + (after Test_locations.fib test_locations.ml(19):581-592 (apply fib (- n 1))) - (after Test_locations.fib test_locations.ml(45):1450-1461 + (after Test_locations.fib test_locations.ml(19):595-606 (apply fib (- n 2))))) - (before Test_locations.fib test_locations.ml(44):1425-1426 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 ff9f5fa82..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:43,14-72} camlTest_locations__fib_81 (n: val) - (if ( 1 From 25e59d63d8b3f86cbd3f0998650d9a580006919f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 20 Oct 2019 11:00:22 +0200 Subject: [PATCH 120/160] Add `'a Either.t = Left of 'a | Right of 'b` ```ocaml val left : 'a -> ('a, 'b) t val right : 'b -> ('a, 'b) t val is_left : ('a, 'b) t -> bool val is_right : ('a, 'b) t -> bool val find_left : ('a, 'b) t -> 'a option val find_right : ('a, 'b) t -> 'b option val map_left : ('a1 -> 'a2) -> ('a1, 'b) t -> ('a2, 'b) t val map_right : ('b1 -> 'b2) -> ('a, 'b1) t -> ('a, 'b2) t val map : left:('a1 -> 'a2) -> right:('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t val fold : left:('a -> 'c) -> right:('b -> 'c) -> ('a, 'b) t -> 'c val equal : left:('a -> 'a -> bool) -> right:('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool val compare : left:('a -> 'a -> int) -> right:('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int ``` 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. --- Changes | 4 + stdlib/.depend | 5 + stdlib/StdlibModules | 2 +- stdlib/either.ml | 66 ++++++++++ stdlib/either.mli | 114 ++++++++++++++++++ stdlib/stdlib.ml | 1 + stdlib/stdlib.mli | 1 + .../tests/basic/patmatch_for_multiple.ml | 41 ++++--- testsuite/tests/generalized-open/gpr1506.ml | 12 +- testsuite/tests/lib-either/test.ml | 108 +++++++++++++++++ testsuite/tests/typing-sigsubst/sigsubst.ml | 6 +- toplevel/dune | 1 + 12 files changed, 331 insertions(+), 30 deletions(-) create mode 100644 stdlib/either.ml create mode 100644 stdlib/either.mli create mode 100644 testsuite/tests/lib-either/test.ml diff --git a/Changes b/Changes index c2779e19b..68eaf39bb 100644 --- a/Changes +++ b/Changes @@ -162,6 +162,10 @@ 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) + - #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) diff --git a/stdlib/.depend b/stdlib/.depend index ffaa61937..14cb21fa2 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 \ 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/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/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..7d7b56f44 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -1347,6 +1347,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/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/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-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/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/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 From ca6f3ee057adf5f57deaabc21e3c108589941581 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 16 Oct 2019 18:16:57 +0200 Subject: [PATCH 121/160] List.partition_map : (a -> (b, c) Either.t) -> a list -> b list * c list --- Changes | 4 ++++ stdlib/.depend | 5 ++++- stdlib/list.ml | 11 +++++++++++ stdlib/list.mli | 15 +++++++++++++++ testsuite/tests/lib-list/test.ml | 15 ++++++++++++++- 5 files changed, 48 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 68eaf39bb..c7da9808d 100644 --- a/Changes +++ b/Changes @@ -166,6 +166,10 @@ Working version 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) diff --git a/stdlib/.depend b/stdlib/.depend index 14cb21fa2..2de48883c 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -392,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 diff --git a/stdlib/list.ml b/stdlib/list.ml index a624f3b43..1fefc3bb9 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 -> diff --git a/stdlib/list.mli b/stdlib/list.mli index 77714f1ff..64a97daa0 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -274,6 +274,21 @@ val partition : ('a -> bool) -> 'a list -> 'a list * 'a list elements of [l] that do not satisfy [p]. 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 p x then Left x else Right x) l] + is equivalent to [partition p l]. + + @since 4.12.0 +*) + (** {1 Association lists} *) diff --git a/testsuite/tests/lib-list/test.ml b/testsuite/tests/lib-list/test.ml index d0b75e6a7..71febbc3a 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 @@ -36,6 +44,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); From 63972f96873a5a733be9a41239f974b933a234f6 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Thu, 3 Sep 2020 11:09:35 +0200 Subject: [PATCH 122/160] Fix injectivity test wrt value restriction (#9867) The original test is rejected when the value restriction is properly implemented. --- testsuite/tests/typing-misc/injectivity.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 *) From 2bb2bde74cd7c6477134570c87491b7b260d8934 Mon Sep 17 00:00:00 2001 From: Greta Yorsh <45005955+gretay-js@users.noreply.github.com> Date: Thu, 3 Sep 2020 12:26:00 +0100 Subject: [PATCH 123/160] Prologue size should not depend on stack_offset (power, arm64) (#9083) * Prologue size does not depend on stack_offset (power, arm64) Define `initial_stack_offset` of a function, independently of stack_offset, and use it to compute both frame_size and prologue_size. --- asmcomp/arm64/emit.mlp | 11 +++++++---- asmcomp/power/emit.mlp | 14 ++++++++------ 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index d5b5caee0..7bd4498e5 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -95,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 = @@ -449,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 () = 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 From a2ecfc45a3beae2a8dddb285725f517ce6acf213 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Tue, 18 Aug 2020 15:00:19 +0200 Subject: [PATCH 124/160] Reorder changes, "language feature" section --- Changes | 60 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/Changes b/Changes index c2779e19b..61afb90b2 100644 --- a/Changes +++ b/Changes @@ -518,6 +518,36 @@ OCaml 4.11 -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 @@ -579,36 +609,6 @@ OCaml 4.11 (Xavier Leroy and Guillaume Melquiond, report by David Brown, review by Gabriel Scherer and David Allsopp) -### 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) - ### Tools: - #9283, #9455, #9457: add a new toplevel directive `#use_output ""` to From 66c368ae7746296285aa5d9498b1beefd7afc3a7 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Thu, 27 Aug 2020 13:57:11 +0200 Subject: [PATCH 125/160] Merge pull request #9857 from lpw25/fix-poly-refs-check Add missing `lower_contravariant` call (fixes #9856) (cherry picked from commit 56707233fb6e33d0e5d0719b8550a15db8aa02d9) --- Changes | 13 +++++++++++-- testsuite/tests/typing-poly/poly.ml | 24 ++++++++++++++++++++++++ typing/typecore.ml | 4 +++- 3 files changed, 38 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 61afb90b2..a52cdd7ed 100644 --- a/Changes +++ b/Changes @@ -407,8 +407,17 @@ Working version (Xavier Leroy, review by Stephen Dolan) -OCaml 4.11 ----------- +OCaml 4.11.1 +------------ + +### Bug fixes: + +- #9856, #9857: Prevent polymorphic type annotations from generalizing + weak polymorphic variables. + (Leo White, review by Jacques Garrigue) + +OCaml 4.11.0 (19 August 2020) +--------------------------- (Changes that can break existing programs are marked with a "*") 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/typing/typecore.ml b/typing/typecore.ml index 69282be05..22eb7ee31 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -5025,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 = From ce04a5c1b16b58ae50529c4c58f4a305e4a23424 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Fri, 28 Aug 2020 09:43:23 +0200 Subject: [PATCH 126/160] Merge pull request #9862 from Octachron/4.11.1_with_less_daring_assertions 9859: revert 9348, inferred function types and :> (cherry picked from commit 28b82e2e397d129840e35fb8da0b8af8b9f59633) --- Changes | 4 ++++ testsuite/tests/typing-misc/labels.ml | 29 +++++++++++++++++++++++++++ typing/ctype.ml | 3 +-- 3 files changed, 34 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index a52cdd7ed..fd943f9bf 100644 --- a/Changes +++ b/Changes @@ -416,6 +416,10 @@ OCaml 4.11.1 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) --------------------------- 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/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 From 1a8aa5428e9f70c674b8db88fe78760241cf7ba6 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Thu, 27 Aug 2020 11:25:10 +0100 Subject: [PATCH 127/160] Add partition_map to ListLabels. --- stdlib/.depend | 3 ++- stdlib/listLabels.mli | 15 +++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/stdlib/.depend b/stdlib/.depend index 2de48883c..c6328a81f 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -409,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/listLabels.mli b/stdlib/listLabels.mli index c98eaeef3..f3a5098dd 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -318,6 +318,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 p x then Left x else Right x) l] + is equivalent to [partition p l]. + + @since 4.12.0 +*) + (** {1 Association lists} *) From de72be7c70dd16fbcc308f1388f211b609241033 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 3 Sep 2020 22:24:37 +0200 Subject: [PATCH 128/160] mention Either in the manual --- manual/manual/library/stdlib-blurb.etex | 1 + 1 file changed, 1 insertion(+) 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 \\ From bab2d10a688d22febec74d96ff11cdec4927fedf Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:25:49 +0100 Subject: [PATCH 129/160] Declare caml_*_ops in headers --- runtime/caml/custom.h | 5 +++++ runtime/custom.c | 5 ----- 2 files changed, 5 insertions(+), 5 deletions(-) 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/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); From bd58bcff8deffd4a27c952db1756e4612ff47726 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:41:29 +0100 Subject: [PATCH 130/160] Remove unimplemented functions in caml/alloc.h --- runtime/caml/alloc.h | 2 -- 1 file changed, 2 deletions(-) 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, From ff7da588d6ad5d09ef053dc5ac1a13beff41f563 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:51:54 +0100 Subject: [PATCH 131/160] Add missing caml_ prefix in minor_gc.h --- runtime/caml/minor_gc.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h index 20baa8d5e..27c1695de 100644 --- a/runtime/caml/minor_gc.h +++ b/runtime/caml/minor_gc.h @@ -67,7 +67,7 @@ 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 */ +CAMLextern void caml_garbage_collection (void); /* runtime/signals_nat.c */ extern void caml_oldify_one (value, value *); extern void caml_oldify_mopup (void); From eb6d803222454465c414d7c26568f1878b0ec608 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:53:29 +0100 Subject: [PATCH 132/160] caml_gc_dispatch doesn't need exporting --- runtime/caml/minor_gc.h | 4 ++-- runtime/minor_gc.c | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h index 27c1695de..0bcb8e512 100644 --- a/runtime/caml/minor_gc.h +++ b/runtime/caml/minor_gc.h @@ -65,9 +65,9 @@ struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt); 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); +extern void caml_gc_dispatch (void); CAMLextern void caml_minor_collection (void); -CAMLextern void caml_garbage_collection (void); /* runtime/signals_nat.c */ +extern void caml_garbage_collection (void); /* runtime/signals_nat.c */ extern void caml_oldify_one (value, value *); extern void caml_oldify_mopup (void); diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index b6b08a1e4..42acd6356 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -462,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 */ From 0fce1e36ae7f5aa652e1758120eea6ea1b55dfcf Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:53:44 +0100 Subject: [PATCH 133/160] Guard most of minor_gc.h with CAML_INTERNALS --- runtime/caml/minor_gc.h | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h index 0bcb8e512..eefd38507 100644 --- a/runtime/caml/minor_gc.h +++ b/runtime/caml/minor_gc.h @@ -63,10 +63,12 @@ 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); extern void caml_gc_dispatch (void); -CAMLextern void caml_minor_collection (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 */ From b4fa3248328597333cf2068950fc1cebd7205757 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:54:52 +0100 Subject: [PATCH 134/160] Explicit export caml_allocation_color --- runtime/memory.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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)){ From c35dc17664d143592a4d58cc07b9d39a17d21d0b Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:57:57 +0100 Subject: [PATCH 135/160] Guard heap functions with CAML_INTERNALS --- runtime/caml/memory.h | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) 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; From 0d4f1ba18290e0b091f6cd6172f4e96156ed9ad2 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 15:59:43 +0100 Subject: [PATCH 136/160] Guard caml_fatal_uncaught_exception with CAML_INTERNALS --- runtime/caml/printexc.h | 2 ++ 1 file changed, 2 insertions(+) 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 } From 8835ed164d897ee29aaa0c19fad265d505e5e230 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 16:19:06 +0100 Subject: [PATCH 137/160] Don't export caml_input_scan_line --- runtime/io.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/io.c b/runtime/io.c index f36f3251c..9415e5324 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -369,7 +369,7 @@ 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; From 0f6d3a3128829c052b6b6679310b1fcda8f9793b Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 16:21:03 +0100 Subject: [PATCH 138/160] Add missing channel declarations in caml/io.h --- runtime/caml/io.h | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/runtime/caml/io.h b/runtime/caml/io.h index bc8316084..34bd5d14c 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -69,7 +69,11 @@ enum { 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 */ From bf05018a1a849ece1621fcd5dff9929897b31cbf Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Fri, 4 Sep 2020 16:22:10 +0100 Subject: [PATCH 139/160] Formalise the Cash exports --- runtime/caml/io.h | 3 +++ runtime/io.c | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/runtime/caml/io.h b/runtime/caml/io.h index 34bd5d14c..d7624ef57 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -75,6 +75,9 @@ 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 *); +CAMLextern void caml_finalize_channel (value); +CAMLextern int caml_do_read (int, char *, unsigned int); + /* I/O on channels from C. The channel must be locked (see below) before calling any of the functions and macros below */ diff --git a/runtime/io.c b/runtime/io.c index 9415e5324..9d19ab3a9 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -416,7 +416,7 @@ 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 ? */ +/* caml_finalize_channel is exported for Cash */ CAMLexport void caml_finalize_channel(value vchan) { struct channel * chan = Channel(vchan); From 961aaf5d1c6ff91cff6b06eb41bc0bb4f2857abd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E7=8F=8A=E7=91=9A?= Date: Sun, 6 Sep 2020 12:12:38 +0200 Subject: [PATCH 140/160] typo (#9886) --- manual/manual/tutorials/lablexamples.etex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 1393a37509d22a27cb1b3201d4f64820bfba4c7a Mon Sep 17 00:00:00 2001 From: octachron Date: Mon, 6 Apr 2020 15:51:55 +0200 Subject: [PATCH 141/160] ocamldoc: fix printing of (::) --- Changes | 3 +++ ocamldoc/odoc_sig.ml | 8 +++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index af1cf4547..77895deff 100644 --- a/Changes +++ b/Changes @@ -373,6 +373,9 @@ 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) + - #9469: Better backtraces for lazy values (Leo White, review by Nicolás Ojeda Bär) 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 From a7d1af4a872e22aebd1e6cc27b2beafdea2ad2dd Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 7 Sep 2020 13:55:59 +0200 Subject: [PATCH 142/160] Test rand.ml: make it less likely to fail Use Random.bits() instead of Random.int 10000 to get a 2^-30 expected failure rate instead of 10^-5. --- testsuite/tests/lib-random/rand.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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" From 422c20013d323ab9d2f9d8a3d609b30ae6222ebd Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 7 Sep 2020 13:54:08 +0100 Subject: [PATCH 143/160] Remove CAMLexport from Cash-exported primitives --- runtime/caml/io.h | 3 --- runtime/io.c | 6 ++---- 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/runtime/caml/io.h b/runtime/caml/io.h index d7624ef57..34bd5d14c 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -75,9 +75,6 @@ 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 *); -CAMLextern void caml_finalize_channel (value); -CAMLextern int caml_do_read (int, char *, unsigned int); - /* I/O on channels from C. The channel must be locked (see below) before calling any of the functions and macros below */ diff --git a/runtime/io.c b/runtime/io.c index 9d19ab3a9..deed1d401 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -266,8 +266,7 @@ 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) { int r; do { @@ -416,8 +415,7 @@ intnat caml_input_scan_line(struct channel *channel) objects into a heap-allocated object. Perform locking and unlocking around the I/O operations. */ -/* caml_finalize_channel is 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; From 83c762974bdb32fe4cb80361bfe2a0d35ba71a05 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Wed, 2 Sep 2020 11:16:12 +0200 Subject: [PATCH 144/160] Document the issue with pos_{in,out} and files opened in text mode Add changes for 9872 --- Changes | 6 +++++- stdlib/stdlib.mli | 16 ++++++++++++++-- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index 833ad2edb..b56eceaa4 100644 --- a/Changes +++ b/Changes @@ -393,7 +393,6 @@ Working version 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) @@ -403,6 +402,11 @@ Working version - #9860: wrong range constraint for subtract immediate on zSystems / s390x (Xavier Leroy, review by Stephen Dolan) +- #9868, #9872: 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 ---------- diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index efd5e9a97..e45e362d5 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 From 6db41e4816965cddce245c30e073db68e9f56a44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 8 Sep 2020 09:55:19 +0200 Subject: [PATCH 145/160] riscv: fix register usage (#9890) --- Changes | 5 +++ asmcomp/riscv/proc.ml | 7 ++-- runtime/riscv.S | 75 +++++++++++++++++++++---------------------- 3 files changed, 46 insertions(+), 41 deletions(-) diff --git a/Changes b/Changes index 892e8df25..195240445 100644 --- a/Changes +++ b/Changes @@ -113,6 +113,11 @@ Working version 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 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/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) From bb186a8633cb3107fcff7287664465470de90946 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Fri, 3 Jul 2020 16:36:09 +0200 Subject: [PATCH 146/160] printtyp: cache old short path data in wrap_env --- typing/printtyp.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 07b22e673..18a3e13b0 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -1584,8 +1584,18 @@ let cltype_declaration id ppf cl = let wrap_env fenv ftree arg = let env = !printing_env in + let old_depth = !printing_depth in + let old_cont = !printing_cont in + let old_pers = !printing_pers in + let old_map = !printing_map in set_printing_env (fenv env); let tree = ftree arg in + printing_depth := old_depth; + printing_cont := old_cont; + printing_pers := old_pers; + printing_map := old_map; + printing_old := env; + (* set_printing_env checks that persistent modules did not change *) set_printing_env env; tree From 5d7663aaa5d93ce6ebae564fcc90865d5dcd1310 Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Tue, 8 Sep 2020 17:13:12 +0200 Subject: [PATCH 147/160] review --- Changes | 3 +++ typing/printtyp.ml | 43 +++++++++++++++++++++++++++++++++---------- 2 files changed, 36 insertions(+), 10 deletions(-) diff --git a/Changes b/Changes index 195240445..e3f1a9a3c 100644 --- a/Changes +++ b/Changes @@ -351,6 +351,9 @@ Working version (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) + ### Build system: - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 18a3e13b0..fe30b3f36 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -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,19 +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 - let old_pers = !printing_pers in - let old_map = !printing_map in set_printing_env (fenv env); let tree = ftree arg in - printing_depth := old_depth; - printing_cont := old_cont; - printing_pers := old_pers; - printing_map := old_map; - printing_old := env; - (* set_printing_env checks that persistent modules did not change *) + 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 From 8f87147c9db8788e5a6f196f1f6da63000c6596e Mon Sep 17 00:00:00 2001 From: progman1 Date: Fri, 10 Apr 2020 12:56:16 +0100 Subject: [PATCH 148/160] toplevel: a discrepancy in extension constructors printing fixes #9148 genprintval.tree_of_extension was missing instantiation of constructor argument types. the Ctype.apply code is factorized out from a number of other places. --- Changes | 4 ++ testsuite/tests/tool-toplevel/printval.ml | 60 +++++++++++++++++++++++ toplevel/genprintval.ml | 37 +++++++------- 3 files changed, 84 insertions(+), 17 deletions(-) create mode 100644 testsuite/tests/tool-toplevel/printval.ml diff --git a/Changes b/Changes index 3fe651ac7..26b098e3c 100644 --- a/Changes +++ b/Changes @@ -385,6 +385,10 @@ Working version - #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) 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/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 From 2235354bd57506a10956e6529b94ae00142b8d2f Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 8 Sep 2020 17:17:02 +0100 Subject: [PATCH 149/160] The opposite of O_TEXT is not O_BINARY (#9892) Extra modes were added in the version 7 CRT (.NET 2002). Update `descriptor_is_in_binary_mode` so that the original mode is correctly restored at exit, even if it is neither `O_TEXT` nor `O_BINARY`. --- Changes | 2 +- runtime/io.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 3fe651ac7..1f1702924 100644 --- a/Changes +++ b/Changes @@ -425,7 +425,7 @@ Working version - #9860: wrong range constraint for subtract immediate on zSystems / s390x (Xavier Leroy, review by Stephen Dolan) -- #9868, #9872: bugs in {in,out}_channel_length and seek_in +- #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) diff --git a/runtime/io.c b/runtime/io.c index 72bd9b5fd..92874752c 100644 --- a/runtime/io.c +++ b/runtime/io.c @@ -84,7 +84,7 @@ Caml_inline int descriptor_is_in_binary_mode(int fd) { #if defined(_WIN32) || defined(__CYGWIN__) int oldmode = setmode(fd, O_TEXT); - if (oldmode == O_BINARY) setmode(fd, O_BINARY); + if (oldmode != -1 && oldmode != O_TEXT) setmode(fd, oldmode); return oldmode == O_BINARY; #else return 1; From 212c0fa70c1a35f9a679d12f2cc6c232d393fb03 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 9 Sep 2020 18:54:00 +0100 Subject: [PATCH 150/160] Allow running a single test in testsuite/Makefile (#9807) * Allow running a single test in testsuite/Makefile. Syntax is `make one FILE=...` * Rename `make list` into `make one LIST=...` for consistency. * Always read actual lines from files read should, as a general rule, always be followed by -r in scripts. If IFS is not empty, then spaces are stripped as well. --- testsuite/Makefile | 54 ++++++++++++++++++++++++++++------------------ 1 file changed, 33 insertions(+), 21 deletions(-) diff --git a/testsuite/Makefile b/testsuite/Makefile index be6c58582..8a88e66f5 100644 --- a/testsuite/Makefile +++ b/testsuite/Makefile @@ -93,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" @@ -115,7 +116,7 @@ all: 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=""; \ @@ -186,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-directory exec-one DIR=$$LINE; \ - done <$(FILE) 2>&1 | tee $(TESTLOG) - @$(MAKE) --no-print-directory 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-directory 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: @@ -227,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"; \ @@ -285,7 +297,7 @@ 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-directory clean-one DIR=$$LINE; \ From 03839754f46319aa36d9dad56940a6f3c3bcb48a Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 9 Sep 2020 20:01:04 +0200 Subject: [PATCH 151/160] List.equal, List.compare (#9668) `List.equal f foo bar` is nicer than `List.length foo = List.length bar && List.for_all2 f foo bar`. Note: with List.compare there is a risk of users having opened the List module, and then using 'compare' from the stdlib unqualified. For example: List.(sort compare foo bar) Such code will break (type error), and has to be fixed by using Stdlib.compare. Stdlib is available since OCaml 4.07; people wishing to support both 4.12 and older releases would have to avoid opening List, or rebind 'compare' locally. --- Changes | 5 +++ stdlib/list.ml | 23 +++++++++++++ stdlib/list.mli | 33 +++++++++++++++++++ stdlib/listLabels.mli | 32 ++++++++++++++++++ testsuite/tests/lib-list/test.ml | 18 ++++++++++ .../comparison_table.compilers.reference | 4 +-- 6 files changed, 113 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index eb3c7d010..23063b3ff 100644 --- a/Changes +++ b/Changes @@ -192,6 +192,11 @@ 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 diff --git a/stdlib/list.ml b/stdlib/list.ml index 1fefc3bb9..5efd72f0f 100644 --- a/stdlib/list.ml +++ b/stdlib/list.ml @@ -549,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 64a97daa0..7b3e9276a 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -102,6 +102,39 @@ val flatten : 'a list list -> 'a list (** An alias for [concat]. *) +(** {1 Comparison} *) + +val equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool +(** [equal eq [a1; ...; an] [b1; ..; bm]] holds when + the two input lists have the same length, and for each + pair of elements [ai], [bi] at the same position we have + [eq ai bi]. + + Note: the [eq] function may be called even if the + lists have different length. If you know your equality + function is costly, you may want to check {!compare_lengths} + first. + + @since 4.12.0 +*) + +val compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int +(** [compare cmp l1 l2] performs a lexicographic comparison + of the two input lists, using the same ['a -> 'a -> int] + interface as {!Stdlib.compare}. + + - [a1 :: l1] is smaller than [a2 :: l2] + if [a1] is smaller than [a2], or if they are equal + and [l1] is smaller than [l2]. + - the empty list [[]] is strictly smaller than non-empty lists. + + Note: the [cmp] function will be called even if the lists have + different lengths. A shorter list is not necessarily smaller, + for example [List.compare [3] [2; 1] > 0]. + + @since 4.12.0 +*) + (** {1 Iterators} *) diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index f3a5098dd..206734026 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -123,6 +123,38 @@ val flatten : 'a list list -> 'a list *) +(** {1 Comparison} *) + +val equal : eq:('a -> 'a -> bool) -> 'a list -> 'a list -> bool +(** [equal eq [a1; ...; an] [b1; ..; bm]] holds when + the two input lists have the same length, and for each + pair of elements [ai], [bi] at the same position we have + [eq ai bi]. + + Note: the [eq] function may be called even if the + lists have different length. If you know your equality + function is costly, you may want to check {!compare_lengths} + first. + + @since 4.12.0 +*) + +val compare : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> int +(** [compare cmp [a1; ...; an] [b1; ...; bm]] performs + a lexicographic comparison of the two input lists, + using the same ['a -> 'a -> int] interface as {!Stdlib.compare}: + + - [a1 :: l1] is smaller than [a2 :: l2] (negative result) + if [a1] is smaller than [a2], or if they are equal (0 result) + and [l1] is smaller than [l2] + - the empty list [[]] is strictly smaller than non-empty lists + + Note: the [cmp] function will be called even if the lists have + different lengths. + + @since 4.12.0 +*) + (** {1 Iterators} *) diff --git a/testsuite/tests/lib-list/test.ml b/testsuite/tests/lib-list/test.ml index 71febbc3a..8f7be225c 100644 --- a/testsuite/tests/lib-list/test.ml +++ b/testsuite/tests/lib-list/test.ml @@ -35,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); 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) From e2ec81fe569b36af0f5c702c176eb53f1c5bd9bd Mon Sep 17 00:00:00 2001 From: Chet Murthy Date: Wed, 9 Sep 2020 13:37:36 -0700 Subject: [PATCH 152/160] re-do of print polyvariants that start with a core_type,closed, not low with leading bar ("|"). a type "[ | w ]" must be printed with the "|", or it won't be reparseable. with tests, Changes entry. # Please enter the commit message for your changes. Lines starting # with '#' will be ignored, and an empty message aborts the commit. # # On branch pr-polyvariant-pprint # Changes to be committed: # modified: Changes # modified: parsing/parsetree.mli # modified: parsing/pprintast.ml # modified: testsuite/tests/parsetree/source.ml # # Untracked files: # Changes.orig # parsing/pprintast.ml.orig # testsuite/tests/parsetree/source.ml.orig # testsuite/tests/parsetree/source.ml.rej # --- Changes | 3 +++ parsing/parsetree.mli | 2 +- parsing/pprintast.ml | 5 ++++- testsuite/tests/parsetree/source.ml | 6 ++++++ 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 23063b3ff..8e2e42f7a 100644 --- a/Changes +++ b/Changes @@ -359,6 +359,9 @@ Working version - #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) + ### Build system: - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For 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..26f27ed58 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 diff --git a/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml index f46e57555..b8d425276 100644 --- a/testsuite/tests/parsetree/source.ml +++ b/testsuite/tests/parsetree/source.ml @@ -7380,3 +7380,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 ;; From 5b8b6de2ac72a401b1cc6a74e570d3ccccc43b23 Mon Sep 17 00:00:00 2001 From: Chet Murthy Date: Wed, 9 Sep 2020 15:15:22 -0700 Subject: [PATCH 153/160] sorry, too-long line in Changes file # Please enter the commit message for your changes. Lines starting # with '#' will be ignored, and an empty message aborts the commit. # # On branch pr-polyvariant-pprint # Your branch is up to date with 'my-fork/pr-polyvariant-pprint'. # # Changes to be committed: # modified: Changes # # Untracked files: # Changes.orig # parsing/pprintast.ml.orig # testsuite/tests/parsetree/source.ml.orig # testsuite/tests/parsetree/source.ml.rej # --- Changes | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 8e2e42f7a..5d63a89d8 100644 --- a/Changes +++ b/Changes @@ -359,8 +359,8 @@ Working version - #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) +- #9591: fix pprint of polyvariants that start with a core_type, closed, + not low (Chet Murthy, review by Florian Angeletti) ### Build system: From df64b46a7c0095d8dc27dfcf70c486454560a259 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 10 Sep 2020 09:54:43 +0100 Subject: [PATCH 154/160] Remove dup. declaration of caml_sys_time_unboxed --- runtime/caml/sys.h | 1 - 1 file changed, 1 deletion(-) 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; From 121cae480148633b9ff772273e67828c2c1128a8 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 10 Sep 2020 11:01:19 +0100 Subject: [PATCH 155/160] Remove CAMLprim and CAMLexport from backtrace.h --- runtime/caml/backtrace.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 */ From 29408deb2cfe59009a31caea53fed4513bf934a6 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 10 Sep 2020 12:05:46 +0100 Subject: [PATCH 156/160] Tidy caml_main declaration --- runtime/caml/startup.h | 2 -- runtime/main.c | 3 +-- 2 files changed, 1 insertion(+), 4 deletions(-) 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/main.c b/runtime/main.c index 5e5839fff..574adce6a 100644 --- a/runtime/main.c +++ b/runtime/main.c @@ -22,12 +22,11 @@ #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 ***); From 503776deb4d9f512dee5a8fb0ee08d6c88f29d95 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 10 Sep 2020 12:11:02 +0100 Subject: [PATCH 157/160] Declare caml_expand_command_line in osdeps.h --- runtime/caml/osdeps.h | 2 ++ runtime/main.c | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime/caml/osdeps.h b/runtime/caml/osdeps.h index 74a3558fd..28451d90a 100644 --- a/runtime/caml/osdeps.h +++ b/runtime/caml/osdeps.h @@ -159,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/main.c b/runtime/main.c index 5e5839fff..3dcf09f85 100644 --- a/runtime/main.c +++ b/runtime/main.c @@ -29,8 +29,6 @@ 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) From 83f0dda553cf4633b7775533e503baeeb0f9f84c Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 10 Sep 2020 13:55:38 +0100 Subject: [PATCH 158/160] Don't use CAMLextern in C files --- otherlibs/unix/mmap.c | 3 +-- otherlibs/unix/mmap_ba.c | 2 +- otherlibs/win32unix/mmap.c | 3 +-- 3 files changed, 3 insertions(+), 5 deletions(-) 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/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) From 435babd6f893c14c2ca0c768afce5d268a32c45a Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 10 Sep 2020 16:34:24 +0100 Subject: [PATCH 159/160] Declare primitives used by unix in io.h --- otherlibs/unix/channels.c | 4 ---- runtime/caml/io.h | 4 ++++ 2 files changed, 4 insertions(+), 4 deletions(-) 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/runtime/caml/io.h b/runtime/caml/io.h index 9102a8291..7b5fe2fd9 100644 --- a/runtime/caml/io.h +++ b/runtime/caml/io.h @@ -128,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 */ From 0d46b5206d934ff9bc3773d4b2752ea3c02e00b8 Mon Sep 17 00:00:00 2001 From: Chet Murthy Date: Thu, 10 Sep 2020 11:09:06 -0700 Subject: [PATCH 160/160] redo: This little patch fixes the pretty-printing of "rebind" extension-constructors (and also rebind exceptions) so that it matches the parser. With tests. a rebind extension like type t += A = M.A [@a] was pretty-printed as type t += A[@a] = M.A [obviously wrong, also not accepted by parser] With tests for extension-constructors and exceptions. # Please enter the commit message for your changes. Lines starting # with '#' will be ignored, and an empty message aborts the commit. # # On branch pr-extension-constructor-rebind-pprint-4.11 # Changes to be committed: # modified: Changes # modified: parsing/pprintast.ml # modified: testsuite/tests/parsetree/source.ml # # Untracked files: # Changes.orig # parsing/pprintast.ml.orig # testsuite/tests/parsetree/source.ml.orig # testsuite/tests/parsetree/source.ml.rej # --- Changes | 3 +++ parsing/pprintast.ml | 4 ++-- testsuite/tests/parsetree/source.ml | 3 +++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 5d63a89d8..0b7708970 100644 --- a/Changes +++ b/Changes @@ -362,6 +362,9 @@ Working version - #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 diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 26f27ed58..442fd6d73 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -1587,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/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml index b8d425276..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